In VISUALIZATION VIBES project Study 2, participants completed an attitutde eliciation survey, asking questions about their attitude toward (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) pseudo-categories (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (that is thus super-powered as it was seen by all participants). Two participant recruitment pools were used: Prolific, with a smaller set of participants recruited from Tumblr (to replicate and compare survey results to Study 1 interviews with participants sourced from Tumblr).

This notebook contains code to replicate quantitative analysis of data from Study 2 reported in the CHI submission. Note that due to limited space, we were unable to report results for all stimulus blocks, and all possible analyses. A separate set of R notebooks are included in the supplementary materials that document analysis of the other blocks not reported here.

This notebook includes analysis and exploration of the data set at the stimulus category level

1 SETUP

We start by importing data files previously wrangled in 0_VIBES_S2_wrangling.Rmd.

1.1 Import Data

############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/input/REFERENCE/ref_stimuli.rds")
ref_surveys <- readRDS("data/input/REFERENCE/ref_surveys.rds")
ref_labels <- readRDS("data/input/REFERENCE/ref_labels.rds")
ref_labels_abs <- readRDS("data/input/REFERENCE/ref_labels_abs.rds")

############## SETUP Graph Labels
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
ref_sd_questions_abs <- rownames(ref_labels_abs)
  

# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)
############## IMPORT DATA FILES
# df_data <- readRDS("data/output/df_data.rds") #1 row per participant — WIDE
df_participants <- readRDS("data/output/df_participants.rds") #1 row per participant — demographic
df_questions <- readRDS("data/output/df_questions.rds") #1 row per question — LONG
df_sd_questions_wide <- readRDS("data/output/df_sd_questions_wide.rds") # only sd questions WIDE


df_tools <- readRDS("data/output/df_tools.rds") #multiselect format for tools Question
df_actions <- readRDS("data/output/df_actions.rds") # multiselect format for action Question
# # df_graphs_full <- readRDS("data/output/df_graphs_full.rds") #includes free response data

df_graphs <- readRDS("data/output/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long <- readRDS("data/output/df_sd_questions_long.rds") # only sd questions LONG

### DATA FILES WITH (VARIABLE-WISE) Z-SCORED SEMANTIC DIFFERENTIAL QS 
df_graphs_z <- readRDS("data/output/df_graphs_z.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/output/df_sd_questions_long_z.rds") # only sd questions LONG


### DATA FILES WITH ABSOLUTE VALUE SEMANTIC DIFFERENTIAL QS 
df_graphs_abs <- readRDS("data/output/df_graphs_abs.rds") #only categorical and numeric questions
df_sd_questions_long_abs <- readRDS("data/output/df_sd_questions_long_abs.rds") # only sd questions LONG

1.2 Set up Graphing

############## SETUP Colour Palettes
#https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/

## list of color pallettes
my_colors = list(
  politics = c("#184aff","#5238bf", "#4f4a52" ,"#84649c", "#ff0000"),
  blackred = c("black","red"),
  greys = c("#707070","#999999","#C2C2C2"),
  greens = c("#ADC69D","#81A06D","#567E39","#2D5D16","#193E0A"),
  smallgreens = c("#ADC69D","#567E39","#193E0A"), ## MALE FEMALE OTHER
  olives = c("#CDCEA1","#B8B979","#A0A054","#78783F","#50502A","#35351C"),
  lightblues = c("#96C5D2","#61A2B2","#3C8093","#2C6378","#1F4A64"),
  darkblues = c("#7AAFE1","#3787D2","#2A73B7","#225E96","#1A4974","#133453"),
  reds = c("#D9B8BD","#CE98A2","#B17380","#954E5F","#78263E","#62151F"),
  traffic = c("#CE98A2","#81A06D","yellow"),
  questions = c("#B17380","#3787D2", "#567E39", "#EE897F"),
  tools= c("#D55662","#EE897F","#F5D0AD","#A0B79B","#499678","#2D363A"), #? ... design.....vis...... programming
  encounter = c("#8E8E8E","#729B7D"), ##SCROLL ENGAGE
  actions2 = c("#8E8E8E","#729B7D"),
  actions4 = c("#8E8E8E", "#A3A3A3","#729B7D","#499678"),
  actions3 = c("#8E8E8E","#99b898ff","#fdcea8ff"),
  actions = c("#8E8E8E","#2A363B","#99b898ff","#fdcea8ff","#ff837bff","#e84a60ff"),
  
  platforms = c("#5D93EA","#FF70CD", "#3BD3F5", "#8B69B5","black"),
  amy_gradient =  c("#ac57aa", "#9e5fa4", "#90689f", "#827099", "#747894", "#66818e", "#578988", "#499183", "#3b997d", "#2da278", "#1faa72"),
  my_favourite_colours = c("#702963", "#637029",    "#296370")
)

## function for using palettes
my_palettes = function(name, n, all_palettes = my_colors, type = c("discrete","continuous"), direction = c("1","-1")) {
  palette = all_palettes[[name]]
  if (missing(n)) {
    n = length(palette)
  }
  type = match.arg(type)
  out = switch(type,
               continuous = grDevices::colorRampPalette(palette)(n),
               discrete = palette[1:n]
  )
  out = switch(direction,
               "1" = out,
               "-1" = palette[n:1])
  structure(out, name = name, class = "palette")
}
############## RETURNS SD STACKED AND COLORED BY BY X
## LOOP STYLE
multi_sd <- function (data, left, right, x, y, color) {

  # g <- ggplot(df, aes(y = .data[[x]], x = {{y}}, color = {{color}}))+
  g <- ggplot(data, aes(y = .data[[x]], x = .data[[y]], color = .data[[color]]))+
  geom_boxplot(width = 0.5) +
  geom_jitter(width = 0.1, alpha=0.5) +
    
  scale_y_continuous(limits=c(-1,101)) +
  labs(x="", y="") +
  coord_flip() +
  guides(
    y = guide_axis_manual(labels = left),
    y.sec = guide_axis_manual(labels = right)
  ) + theme_minimal()

  return(g)
}


############## RETURNS SINGLE SD 
## LOOP STYLE
single_sd <- function (data, left, right, x) {

  g <- ggplot(data, aes(y = {{x}}, x = ""))+
  geom_boxplot(width = 0.5) +
  geom_jitter(width = 0.1, alpha=0.5) +
  scale_y_continuous(limits=c(-1,101)) +
  labs(x="", y="") +
  coord_flip() +
  guides(
    y = guide_axis_manual(labels = left),
    y.sec = guide_axis_manual(labels = right)
  ) + theme_minimal()

  return(g)
}


# ######## RETURNS SINGLE SD
# ##  APPLY STYLE
plot_sd = function (data, column, type, mean, facet, facet_by, boxplot, labels) {

  ggplot(data, aes(y = .data[[column]], x="")) +
    {if(boxplot) geom_boxplot(width = 0.5) } +
    geom_jitter(width = 0.1, alpha=0.2, {if(facet) aes(color=.data[[facet_by]])}) +
    {if(mean)
      stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue")
      } +
    {if(mean)
      ## assumes data has been passed in with mean column at m
      # stat_summary(fun="mean", geom="text", colour="blue",  fontface = "bold",
      #            vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
      stat_summary(fun="mean", geom="text", colour="blue",  fontface = "bold",
                 vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
      } +

    {if(facet) facet_grid(.data[[facet_by]] ~ .)} +
    # scale_y_continuous(limits=c(-1,101)) +
    labs(x="", y="") +
    coord_flip()  +
    {if(type == "S")
      guides(
        y = guide_axis_manual(labels = labels[column,"left"]),
        y.sec = guide_axis_manual(labels = labels[column,"right"])
      )} +
    {if(type == "Q")
      guides(
        y = guide_axis_manual(labels = labels[q,"left"]),
        y.sec = guide_axis_manual(labels = labels[q,"right"])
      )} +
  theme_minimal()  +
     labs (
       caption = column
     ) + easy_remove_legend()
}

2 STIMULUS-CATEGORY

For the purpose of optimizing aesthetic diversity of stimuli seen by each participant, we organized the stimuli into 4 approximate ‘categories’ of abstraction, where A = the most abstract, and D the most figural. Each participant first saw the common stimulus (B0-0) followed by one stimulus from each category (order randomized) in a block structure.

2.1 SAMPLE

2.1.1 Sample Demographics

df <- df_participants

## FOR DESCRIPTIVES PARAGRAPH
# #PROLIFIC
df.p <- df %>% filter(Distribution == "PROLIFIC")
desc.gender.p <- table(df.p$D_gender) %>% prop.table()
names(desc.gender.p) <- levels(df.p$D_gender)
p_participants <- nrow(df.p)

# #TUMBLR
df.t <- df %>% filter(Distribution == "TUMBLR")
desc.gender.t <- table(df.t$D_gender) %>% prop.table()
names(desc.gender.t) <- levels(df.t$D_gender)
t_participants <- nrow(df.t)

For study 2, a total of 318 participants were recruited from US-located English speaking users of TUMBLR (n = 78) and PROLIFIC (n = 240).

240 individuals from PROLIFIC participated in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 1% Other).

78 individuals from Tumblr participated in Study 2, ( 36% Female, 5% Male, 40% Non-binary, 19% Other). Note that a higher proportion of participants recruited from TUMBLR report identities other than cis-gender Female and cis-gender Male.

2.1.2 Study Response Time

df <- df_participants

## for descriptives paragraph
p.desc.duration <- psych::describe(df %>% filter(Distribution=="PROLIFIC") %>% pull(duration.min))
t.desc.duration <- psych::describe(df %>% filter(Distribution=="TUMBLR") %>% pull(duration.min))

PROLIFIC SAMPLE (n = 240 ) participant response times ranged from 13.97 to 216.18 minutes, with a mean response time of 42.49 minutes, SD = 21.15.

TUMBLR SAMPLE (n = 78 ) participant response times ranged from 10.88 to 227.57 minutes, with a mean response time of 51.93 minutes, SD = 35.47.

rm(df, df.p, df.t, p.desc.duration, t.desc.duration, desc.gender.p, desc.gender.t, p_participants, t_participants)
#full data except for common stimulus B0-0
df_cat <- df_graphs %>% 
  filter(STIMULUS != "B0-0") %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
    STUDY = "" #dummy variable for univariate visualizations
  )
# %>%
#   mutate(MAKER_ID = fct_rev(MAKER_ID))

2.2 CONFIDENCE

When asking participants to identify the type, age and gender of the maker of a visualization, we also asked participants to indicate their confidence in these choices.

Across all participants and all stimuli, are these (categorical) questions answered with the same degree of confidence?

Here we examine both the central tendency (mean) and shape of the distribution for each confidence variable.

df <- df_cat %>% select(PID, Distribution, STIMULUS_CATEGORY, STIMULUS,MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF) %>% 
  pivot_longer(
    cols = c(MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF),
    names_to = "QUESTION",
    values_to = "CONFIDENCE"
  ) %>% 
  mutate(
    QUESTION = factor(QUESTION, levels=c("MAKER_CONF","AGE_CONF","GENDER_CONF","TOOL_CONF"  ) )
  ) %>% 
  group_by(QUESTION, STIMULUS_CATEGORY) %>% 
  mutate(
    m=round(mean(CONFIDENCE),0) #calc mean for showing in plots 
  )


## B
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## BOXPLOT W/ JITTER
B <-
  df %>% 
  ggplot(aes(x=STIMULUS_CATEGORY, y= CONFIDENCE, fill = STIMULUS_CATEGORY)) + 
  geom_jitter(aes(color = STIMULUS_CATEGORY), alpha = 0.25, position=position_dodge2(width = 0.25)) + 
  geom_boxplot(width = 0.5) + 
  facet_wrap(~QUESTION)+
  ## MEAN
    stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size=3,
                 vjust=+0.5, hjust = -1.5, aes( label=round(m, digits=0)))+
    stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
  theme_minimal() + easy_remove_legend()
  labs(title = "Confidence by Question and Stimulus Category", caption = "(mean in blue)")
## $title
## [1] "Confidence by Question and Stimulus Category"
## 
## $caption
## [1] "(mean in blue)"
## 
## attr(,"class")
## [1] "labels"
## R
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## RIDGEPLOT W/ INTERVAL MEAN
R <-
  df %>% 
  ggplot(aes(x=CONFIDENCE, y=STIMULUS_CATEGORY, fill=STIMULUS_CATEGORY)) + 
    geom_density_ridges(scale = 0.65, alpha = 0.75, quantile_lines = TRUE) +
    scale_x_continuous(limits = c(0,100))+
    # scale_fill_manual(values = my_palettes(name="questions", direction = "-1"), name = "",  guide = guide_legend(reverse = TRUE)) +   
    stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
    facet_wrap(~QUESTION)+
  ## MEAN
    stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size=3,
                vjust=+2.5, hjust = 0.50, aes( label=round(m, digits=0)))+
    stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
  theme_minimal() + 
  labs(title = "Confidence by Question and Stimulus Category", y = "QUESTION", caption =" (mean in blue)") + 
  easy_remove_legend()

B

R
## Picking joint bandwidth of 6.35
## Picking joint bandwidth of 5.91
## Picking joint bandwidth of 7.16
## Picking joint bandwidth of 6.14

2.3 MAKER ID

Participants were asked:

Who do you think is most likely responsible for having this image created?
options: (select one). The response is stored as MAKER_ID

  • business or corporation

  • journalist or news outlet

  • educational or academic institution

  • government or political organization

  • other organization

  • an individual]

Participants were also asked: Please rate your confidence in this choice. The response is stored as MAKER_CONF .

#FILTER DATASET
df <- df_cat


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_ID = fct_rev(MAKER_ID) )
S <-   ggbarstats( data = dx, x = MAKER_ID, y = STIMULUS_CATEGORY,
                   results.subtitle = FALSE,
                   legend.title = "MAKER ID") + 
    scale_fill_manual(values = my_palettes(name="reds", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################


## H
## HALF EYE SLAB GGDIST
##############################
H <-
  df %>% 
  group_by(MAKER_ID, STIMULUS_CATEGORY) %>% 
  mutate(count = n(), m = mean(MAKER_CONF)) %>% 
  ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_ID), fill = fct_rev(MAKER_ID))) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  facet_wrap(~STIMULUS_CATEGORY)+
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker ID Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################
  

S + plot_annotation(
  title = "Maker ID by STIMULUS CATEGORY",
  # subtitle = "the categories of MAKER ID were chosen in similar proportion, 
  # and both the mean (in blue) and shape of distribution of confidence scores is similar across values of Maker ID",
  caption = "(blue indicates mean)"
)

H + plot_annotation(
  title = "Maker ID Confidence by STIMULUS CATEGORY",
  # subtitle = "the categories of MAKER ID were chosen in similar proportion, 
  # and both the mean (in blue) and shape of distribution of confidence scores is similar across values of Maker ID",
  caption = "(blue indicates mean)"
)

2.4 MAKER AGE

Participants were asked: Take a moment to imagine the person(s) responsible for creating the image. What generation are they most likely from?
options: (select one) The response was saved as MAKER_AGE

  • boomers (60+ years old)

  • Generation X (44-59 years old)

  • Millennials (28-43 years old)

  • Generation Z (12 - 27 years old]

Participants were asked: Please rate your confidence in this choice. The response is stored as AGE_CONF .

#FILTER DATASET
df <- df_cat


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <-   ggbarstats( data = dx, x = MAKER_AGE, y = STIMULUS_CATEGORY,
                   legend.title = "MAKER AGE",
                   results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="lightblues", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################


  
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>% 
  group_by(MAKER_AGE, STIMULUS_CATEGORY) %>% 
  mutate(count = n(), m = mean(AGE_CONF)) %>% 
  ggplot(aes(y = AGE_CONF, x = fct_rev(MAKER_AGE), fill = fct_rev(MAKER_AGE))) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  facet_wrap(~STIMULUS_CATEGORY)+
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker AGE Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################


S  + plot_annotation(
  title = "Maker AGE by STIMULUS CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

H + plot_annotation(
  title = "Maker AGE Confidence by STIMULUS CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

2.5 MAKER GENDER

Participants were asked: Take a moment to imagine the person(s) responsible for creating the image. What gender do they most likely identify with?
options: [female / male / other ] (select one). Responses were stored as MAKER_GENDER.

Participants were asked: Please rate your confidence in this choice. The response is stored as GENDER_CONF .

#FILTER DATASET
df <- df_cat


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <-   ggbarstats( data = dx, x = MAKER_GENDER, y = STIMULUS_CATEGORY,
                   legend.title = "MAKER GENDER", 
                   results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1")) +
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################



## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>% 
  group_by(MAKER_GENDER, STIMULUS_CATEGORY) %>% 
  mutate(count = n(), m = mean(GENDER_CONF)) %>% 
  ggplot(aes(y = GENDER_CONF, x = MAKER_GENDER, fill = MAKER_GENDER)) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  facet_wrap(~STIMULUS_CATEGORY) + 
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="greens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="Maker GENDER Confidence", x="") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################

  

S + plot_annotation(
  title = "Maker GENDER by STIMULUS CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

H + plot_annotation(
  title = "Maker GENDER Confidence by STIMULUS_CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

2.6 TOOL ID

Participants were asked: What tools do you think were most likely used to create this image?
options: (select all that apply). The response was saved as variable TOOL_ID (multi-select)

  • basic graphic design software (e.g. Canva, or similar)

  • advanced graphic design software (e.g. Adobe Illustrator, Figma, or similar)

  • data visualization software (e.g. Tableau, PowerBI, or similar)

  • general purpose software (e.g. MS Word/Excel, Google Sheets, or similar)

  • programming language (e.g. R, python, javascript, or similar)

Participants were asked: Please rate your confidence in this choice. The response is stored as TOOL_CONF .

#FILTER DATASET
df <- df_tools %>% 
  mutate(
    STUDY = "",
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
  )


## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
S <-   ggbarstats( data = df, x = TOOL_ID, y = STIMULUS_CATEGORY,
                   legend.title = "TOOL ID", results.subtitle = FALSE) + 
    scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    theme_minimal() +
    labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################



## H
## HALF EYE SLAB GGDIST
##############################
H <-  df %>% 
  group_by(TOOL_ID, STIMULUS_CATEGORY) %>% 
  mutate(count = n(), m = mean(TOOL_CONF)) %>% 
  ggplot(aes(y = TOOL_CONF, x = TOOL_ID, fill = TOOL_ID)) + 
  stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
  facet_wrap(~STIMULUS_CATEGORY) + 
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2,
               vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
  stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
  scale_fill_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
  geom_text(aes(label= paste0("n=",count) ,  y = 5), color = "black",
            size = 3, nudge_x=0.35) + 
  labs(y="TOOL ID Confidence", x="", caption="(mean in blue) (median in red)") + 
  theme_minimal() + 
  easy_remove_legend()+
  coord_flip() 
##############################
  

S + plot_annotation(
  title = "TOOL ID by STIMULUS CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

H + plot_annotation(
  title = "TOOL ID Confidence by STIMULUS CATEGORY",
  # subtitle = "The value
  # distribution of confidence scores is similar across values of Maker AGE",
  caption = "(blue indicates mean)"
)

2.7 ENCOUNTER CHOICE

The first question each participant saw in each stimulus block was: As you’re scrolling through your feed, you see this image. What would you do?

options: keep scrolling, pause and look at the image. (select one) The response was saved as variable ENCOUNTER

## B
## ENCOUNTER  BY STIMULUS
## GGSTATSPLOT
df_cat %>% 
  ggbarstats(  
            x = ENCOUNTER, y = STIMULUS_CATEGORY,
            legend.title = "ENCOUNTER",
            results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))+
    theme_minimal() + 
    labs( title = "ENCOUNTER Choice by STIMULUS_CATEGORY", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

2.7.1 AD HOC EXPLORE ENCOUNTER

df_cat %>% 
ggbivariate(outcome = "ENCOUNTER", explanatory = ref_conf_questions)

df_cat %>% 
ggbivariate(outcome = "ENCOUNTER", explanatory = ref_cat_questions)

df_cat %>% 
ggbivariate(outcome = "ENCOUNTER", explanatory = ref_sd_questions)

2.8 ACTION CHOICE

The last question participants were asked in each stimulus block was: Imagine you encounter the following image while scrolling. Which of the following are you most likely to do?

options: (select all that apply). The response was saved as variable CHART_ACTION

  • post a comment

  • share/repost

  • share/repost WITH comment

  • look up more information about the topic or source

  • unfollow/block the source

  • NOTHING—just keep scrolling

## B
## ACTION  BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
  CHART_ACTION = fct_rev(CHART_ACTION),
  STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
  STUDY="") %>% 
  ggbarstats( x = CHART_ACTION, y = STIMULUS_CATEGORY,
            legend.title = "CHART ACTION",
            results.subtitle = FALSE) + 
    # scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
    theme_minimal() + 
    labs( title = "ACTION Choice by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

## B
## ACTION  BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
  CHART_ACTION4 = fct_rev(CHART_ACTION4),
  STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
  STUDY="") %>% 
  ggbarstats( x = CHART_ACTION4, y = STIMULUS_CATEGORY,
            legend.title = "collapsed CHART ACTION",
            results.subtitle = FALSE) + 
    # scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
    theme_minimal() + 
    labs( title = "collapsed ACTION Choice4 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

## B
## ACTION  BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
  CHART_ACTION3 = fct_rev(CHART_ACTION3),
  STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
  STUDY="") %>% 
  ggbarstats( x = CHART_ACTION3, y = STIMULUS_CATEGORY,
            legend.title = "collapsed CHART ACTION",
            results.subtitle = FALSE) + 
    # scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
    theme_minimal() + 
    labs( title = "collapsed ACTION Choice3 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

## B
## ACTION  BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
  CHART_ACTION2 = fct_rev(CHART_ACTION2),
  STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
  STUDY="") %>% 
  ggbarstats( x = CHART_ACTION2, y = STIMULUS_CATEGORY,
            legend.title = "collapsed CHART ACTION",
            results.subtitle = FALSE) + 
    # scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
    scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
    theme_minimal() + 
    labs( title = "collapsed ACTION Choice2 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

2.9 SEMANTIC DIFFERENTIALS

Participants were also asked to rate certain characteristics of the chart, or its maker, along a semantic differential scale, implemented in Qualtrics as a continuous slider ranging from 0 -> 100 with biploar adjectives at the end of each scale. The slider defaulted to the center point (50), and the interface displayed the numeric value of the slider position as a tooltip while the element had focus. Note that on both touch and mouse devices participants could interact with the survey element as a slider (i.e. click and and drag, or touch and drag) or as a visual analogue scale (i.e. click or tap on position along the scale).

2.9.1 Full Scales

The SD scores visualized here are in the same form as the participants’ response scale (slider from 0-100).

#### GROUPED DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)  
  d <- left_join( x = df, y = ref_labels, 
                  by = c("QUESTION" = "ref_sd_questions")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions),
          STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))%>% 
    group_by(QUESTION) %>% 
    mutate(m=median(value)) ## calc median for printing on graph
  
  
(  c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+ 
    geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
    ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=-0.5, hjust = 0.50, aes(label=round(m, digits=0)))+
    stat_summary(fun=median, geom="point", size=1) +
    facet_grid2(.~STIMULUS_CATEGORY)+
    # geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25) 
    guides(
      y = guide_axis_manual(labels = rev(ref_labels$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels$right))
    ) +
    labs(title = "by STIMULUS CATEGORY", y = "", caption = "(point is median)") +
    cowplot::draw_text(text = ref_sd_questions, x = 40, y= ref_sd_questions, size = 6, vjust=2) + ##raw
    # # cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14

if(GRAPH_SAVE){
    ggsave(plot = c, path="figs/level_category/distributions", filename =paste0("combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14  )
}  
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14
rm(df,d, c)

2.9.2 Absolute Values

Here the scale of the semantic differential questions have been collapsed, such that 0 is the midpoint of the scale (indicating uncertainty, or not strongly indicating either of the labelled traits) and both 100 and 0 are 50 (indicating a strong signal toward either of the labelled traits).

  #### GROUPED DENSITY RIDGES#############################################################################
  # setup dataframe 
  df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)  
  d <- left_join( x = df, y = ref_labels_abs, 
                  by = c("QUESTION" = "ref_sd_questions_abs")) %>% 
        mutate(
          category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
          QUESTION = factor(QUESTION, levels=ref_sd_questions),
          STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))%>% 
    group_by(QUESTION) %>% 
    mutate(m=median(value)) ## calc median for printing on graph
  
  
(  c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+ 
    geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
    facet_grid2(.~STIMULUS_CATEGORY)+
     ## MEDIAN
    stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
                vjust=-0.5, hjust = 0.50, aes(label=round(m, digits=0)))+
    stat_summary(fun=median, geom="point", size=1) +
    # geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25) 
    guides(
      y = guide_axis_manual(labels = rev(ref_labels_abs$left)),
      y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
    ) +
    labs(title = "by STIMULUS CATEGORY (absolute value)", y = "") +
    cowplot::draw_text(text = ref_sd_questions_abs, x = 20, y= ref_sd_questions_abs, size = 6, vjust=2) + ##raw
    theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84

if(GRAPH_SAVE == TRUE){
    ggplot2::ggsave(plot = c, path="figs/level_category/distributions", filename =paste0("ABS_combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14  )
}
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84
rm(df, d, c)

2.10 CORRELATIONS

2.10.1 correlation matrices — semantic differential

df <- df_graphs %>% 
  filter(STIMULUS != "B0-0") %>% 
  select(
          MAKER_DESIGN, MAKER_DATA, 
          MAKER_POLITIC, MAKER_ARGUE,
          MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
          CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
          PID)

print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>%  correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |     -0.41*** |   -0.33*** |        -0.03 |    -0.17*** |    -0.17*** |    -0.14*** |    0.16*** |       -0.04 |       0.13*** |    0.36***
## MAKER_DATA    |     -0.19*** |   -0.24*** |      0.33*** |    -0.39*** |    -0.39*** |    -0.23*** |    0.18*** |    -0.17*** |       0.13*** |           
## MAKER_POLITIC |     -0.21*** |   -0.28*** |      0.21*** |    -0.29*** |    -0.36*** |    -0.44*** |    0.46*** |    -0.29*** |               |           
## MAKER_ARGUE   |      0.24*** |    0.30*** |     -0.35*** |     0.44*** |     0.51*** |     0.40*** |   -0.46*** |             |               |           
## MAKER_SELF    |     -0.36*** |   -0.46*** |      0.34*** |    -0.52*** |    -0.60*** |    -0.65*** |            |             |               |           
## MAKER_ALIGN   |      0.40*** |    0.51*** |     -0.32*** |     0.57*** |     0.64*** |             |            |             |               |           
## MAKER_TRUST   |      0.36*** |    0.49*** |     -0.47*** |     0.74*** |             |             |            |             |               |           
## CHART_TRUST   |      0.46*** |    0.59*** |     -0.50*** |             |             |             |            |             |               |           
## CHART_INTENT  |     -0.12*** |   -0.21*** |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.83*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
               subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()

print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE,multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |     -0.27*** |       0.01 |     -0.17*** |        0.05 |       -0.03 |        0.07 |       0.07 |        0.08 |          0.08 |    0.32***
## MAKER_DATA    |         0.09 |      -0.03 |      0.21*** |    -0.13*** |    -0.15*** |       -0.02 |   -0.13*** |    9.23e-03 |         -0.04 |           
## MAKER_POLITIC |         0.01 |      -0.02 |         0.03 |        0.04 |       -0.06 |    -0.19*** |    0.22*** |       -0.06 |               |           
## MAKER_ARGUE   |         0.06 |      -0.03 |     -0.12*** |        0.05 |     0.16*** |    9.31e-03 |   -0.16*** |             |               |           
## MAKER_SELF    |     5.85e-03 |      -0.07 |         0.06 |       -0.02 |    -0.18*** |    -0.34*** |            |             |               |           
## MAKER_ALIGN   |         0.01 |     0.11** |         0.06 |        0.08 |     0.24*** |             |            |             |               |           
## MAKER_TRUST   |        -0.06 |       0.02 |      -0.11** |     0.40*** |             |             |            |             |               |           
## CHART_TRUST   |         0.03 |    0.23*** |     -0.26*** |             |             |             |            |             |               |           
## CHART_INTENT  |         0.03 |       0.03 |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.74*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point",   show_text = "label",
     stars=TRUE, show_legend=FALSE,
     show_statistic = FALSE, show_ci = FALSE) + 
     theme_minimal()+
     labs(title = "Correlation Matrix — SD Questions", 
          subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
     # text = list(fontface = "italic")
g

ggsave(g, scale =1, filename = "figs/level_category/heatmaps/blocks_partial_correlation_no_b00.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)

#PLOT GAUSSIAN GRAPH MODEL
# plot(c)


###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH

## GET THE MATRIX
m <- as.matrix(c)


## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
         order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
         tl.col = "black")

These plots depict the PARTIAL CORRELATION pairwise between variables (partial correlation factors out influence of other variables), with participant ID as a random effect. The resulting values are pearson moment-correlation coefficients ranging of -1 (direct negative) to +1 direct positive correlation. These correlations are calculated on the full scale semantic differential questions (i.e. with the 0 - 100 range, where 1 and 100 are end points and 50 is the central point)

2.10.2 correlation matrices — semantic differential — absolute values

df <- df_graphs_abs %>% 
  filter(STIMULUS != "B0-0") %>% 
  select(
          MAKER_DESIGN, MAKER_DATA, 
          MAKER_POLITIC, MAKER_ARGUE,
          MAKER_SELF, MAKER_ALIGN, MAKER_TRUST, 
          CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY, 
          PID)

print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>%  correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |      0.24*** |    0.23*** |      0.13*** |     0.20*** |     0.19*** |     0.14*** |    0.16*** |     0.18*** |       0.14*** |    0.42***
## MAKER_DATA    |      0.18*** |    0.18*** |      0.29*** |     0.25*** |     0.24*** |     0.12*** |    0.19*** |     0.21*** |         0.06* |           
## MAKER_POLITIC |      0.17*** |    0.24*** |      0.11*** |     0.31*** |     0.34*** |     0.60*** |    0.50*** |     0.47*** |               |           
## MAKER_ARGUE   |      0.17*** |    0.21*** |      0.23*** |     0.38*** |     0.46*** |     0.46*** |    0.56*** |             |               |           
## MAKER_SELF    |      0.21*** |    0.28*** |      0.22*** |     0.41*** |     0.51*** |     0.64*** |            |             |               |           
## MAKER_ALIGN   |      0.24*** |    0.32*** |      0.21*** |     0.45*** |     0.54*** |             |            |             |               |           
## MAKER_TRUST   |      0.15*** |    0.26*** |      0.30*** |     0.62*** |             |             |            |             |               |           
## CHART_TRUST   |      0.32*** |    0.44*** |      0.40*** |             |             |             |            |             |               |           
## CHART_INTENT  |      0.18*** |    0.21*** |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.69*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
               subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()

print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE, multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
## 
## Parameter     | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN  |         0.08 |       0.05 |        -0.06 |   -2.56e-03 |        0.04 |       -0.02 |       0.01 |        0.04 |          0.05 |    0.31***
## MAKER_DATA    |         0.03 |  -9.61e-03 |      0.17*** |        0.04 |        0.07 |       -0.05 |       0.04 |        0.06 |         -0.07 |           
## MAKER_POLITIC |    -5.90e-03 |       0.04 |        -0.04 |        0.03 |       -0.05 |     0.37*** |      0.10* |     0.24*** |               |           
## MAKER_ARGUE   |         0.02 |      -0.02 |         0.04 |        0.04 |     0.14*** |    4.39e-03 |    0.26*** |             |               |           
## MAKER_SELF    |    -2.83e-04 |       0.03 |         0.02 |   -6.34e-03 |     0.12*** |     0.35*** |            |             |               |           
## MAKER_ALIGN   |         0.03 |       0.06 |     5.07e-03 |        0.05 |     0.22*** |             |            |             |               |           
## MAKER_TRUST   |       -0.10* |      -0.01 |         0.06 |     0.40*** |             |             |            |             |               |           
## CHART_TRUST   |         0.06 |    0.20*** |      0.24*** |             |             |             |            |             |               |           
## CHART_INTENT  |    -1.63e-03 |  -8.18e-03 |              |             |             |             |            |             |               |           
## CHART_LIKE    |      0.62*** |            |              |             |             |             |            |             |               |           
## 
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point",   show_text = "label",
     stars=TRUE, show_legend=FALSE,
     show_statistic = FALSE, show_ci = FALSE) + 
     theme_minimal()+
     labs(title = "Correlation Matrix — SD Questions — absolute values", 
          subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
     # text = list(fontface = "italic")
g

ggsave(g, scale =1, filename = "figs/level_category/heatmaps/blocks_partial_correlation_abs_no_b00.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)

#PLOT GAUSSIAN GRAPH MODEL
# plot(c)


###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH

## GET THE MATRIX
m <- as.matrix(c)


## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
         order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
         tl.col = "black")

3 EXPLORATORY QUESTIONS

3.0.1 CHART ACTION ~ CATEGORY

3.0.1.1 visualize

df <- df_actions %>% 
  select(STIMULUS, STIMULUS_CATEGORY, BLOCK, CHART_ACTION, CHART_LIKE, PID) %>% 
  mutate(
CHART_ACTION = fct_rev(CHART_ACTION),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
  ) %>% filter(STIMULUS != "B0-0")


# m <- glm(df)


## CATEGORY
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = CHART_ACTION, y = STIMULUS_CATEGORY,
        results.subtitle = FALSE) + 
scale_fill_manual(values = my_palettes(name="actions", direction = "1")) +
theme_minimal() +
# labs( title = "",  x = "", y="") + 
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################

## BLOCK
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = CHART_ACTION, y = BLOCK,
        results.subtitle = FALSE) + 
scale_fill_manual(values = my_palettes(name="actions", direction = "1")) +
theme_minimal() +
# labs( title = "",  x = "", y="") + 
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################


## CATEGORY / BLOCK
# GGSTATSPLOT
##############################
grouped_ggbarstats( data = df, x = CHART_ACTION, y = STIMULUS_CATEGORY,   grouping.var=BLOCK,
                results.subtitle = FALSE,
                ggplot.component = scale_fill_manual(values = my_palettes(name="actions", direction = "1"))) + 
theme_minimal() +
# labs( title = "",  x = "", y="") + 
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################


# BLOCK / CATEGORY
# GGSTATSPLOT
##############################
grouped_ggbarstats( data = df, x = CHART_ACTION, y = BLOCK,   grouping.var=STIMULUS_CATEGORY,
                results.subtitle = FALSE,
                ggplot.component = scale_fill_manual(values = my_palettes(name="actions", direction = "1"))) + 
theme_minimal() +
# labs( title = "",  x = "", y="") + 
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################

# STIMULUS
# GGSTATSPLOT
# TODO STACKED BAR BY ACTION

3.0.1.2 model

3.0.1.2.1 DATA SETUP
df <- df_actions %>%
  ## FILTER OUT B0-0 COMMON STIMULUS (so cells can be balanced)
  filter(STIMULUS != "B0-0") %>%
  select(CHART_ACTION, CHART_ACTION2, CHART_ACTION3, CHART_ACTION4, STIMULUS, STIMULUS_CATEGORY, BLOCK, MAKER_ID, CHART_LIKE, CHART_TRUST, CHART_BEAUTY, MAKER_DESIGN, MAKER_ALIGN, CHART_INTENT, MAKER_TRUST, MAKER_DATA, MAKER_DESIGN, MAKER_ARGUE, MAKER_POLITIC, MAKER_SELF, PID) %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), #REVERSE FACTOR ORDER SO A IS REFERENCE
    ALIGN_Z = datawizard::standardise(MAKER_ALIGN),
    TRUST_Z = datawizard::standardise(CHART_TRUST),
    BEAUTY_Z = datawizard::standardise(CHART_BEAUTY),
    LIKE_Z = datawizard::standardise(CHART_LIKE),
    INTENT_Z = datawizard::standardise(CHART_INTENT),
    MAKERTRUST_Z = datawizard::standardise(MAKER_TRUST),
    DESIGN_Z = datawizard::standardise(MAKER_DESIGN),
    DATA_Z = datawizard::standardise(MAKER_DATA),
    ARGUE_Z = datawizard::standardise(MAKER_ARGUE),
    SELF_Z = datawizard::standardise(MAKER_SELF),
    ABS_POLITIC = datawizard::standardize(abs(MAKER_POLITIC - 50)) #standardize after halfving scale 
  ) %>% 
  droplevels()
    
  
    ## (only used if NOT filtering out B0-0)
    ## RECODE #recode b00 graph as category D [bc it fits in that category]
    # STIMULUS_CATEGORY = fct_recode(STIMULUS_CATEGORY, D="F") 
3.0.1.2.2 (WIP) CHART ACTION ~ ?
## reference level is nothing, 

################## ENCOUNTER ~ CATEGORY + LIKE #################
f <-  "ACTION ~ ?? (1|PID)"
mm <- glmer(CHART_ACTION2 ~ STIMULUS_CATEGORY + LIKE_Z + ABS_POLITIC + (1|PID), 
                data = df,family = "binomial", 
                 control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
               optCtrl=list(maxfun=2e5)))
car::Anova(mm, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: CHART_ACTION2
##                     Chisq Df            Pr(>Chisq)    
## STIMULUS_CATEGORY  23.151  3         0.00003756521 ***
## LIKE_Z            169.382  1 < 0.00000000000000022 ***
## ABS_POLITIC        28.714  1         0.00000008391 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: CHART_ACTION2 ~ STIMULUS_CATEGORY + LIKE_Z + ABS_POLITIC + (1 |  
##     PID)
##    Data: df
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 200000))
## 
##      AIC      BIC   logLik deviance df.resid 
##   1654.2   1691.1   -820.1   1640.2     1444 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.0474 -0.6261 -0.2650  0.6368  6.6181 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 1.125    1.061   
## Number of obs: 1451, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)        -0.78739    0.15460  -5.093         0.0000003522 ***
## STIMULUS_CATEGORYB  0.17973    0.19034   0.944             0.345040    
## STIMULUS_CATEGORYC  0.66820    0.19320   3.459             0.000543 ***
## STIMULUS_CATEGORYD  0.79225    0.19056   4.157         0.0000321750 ***
## LIKE_Z              1.14892    0.08828  13.015 < 0.0000000000000002 ***
## ABS_POLITIC         0.43435    0.08106   5.359         0.0000000839 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## STIMULUS_CATEGORYB -0.644                                      
## STIMULUS_CATEGORYC -0.683  0.516                               
## STIMULUS_CATEGORYD -0.679  0.520              0.552            
## LIKE_Z             -0.138  0.053              0.061            
## ABS_POLITIC         0.082 -0.023             -0.201            
##                    STIMULUS_CATEGORYD LIKE_Z
## STIMULUS_CATEGORYB                          
## STIMULUS_CATEGORYC                          
## STIMULUS_CATEGORYD                          
## LIKE_Z              0.069                   
## ABS_POLITIC        -0.095              0.277
performance(mm)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1654.168 | 1654.246 | 1691.128 |      0.461 |      0.276 | 0.255 | 0.379 | 1.000 |    0.449 |      -Inf |           0.002
m <- mm
f <- f
## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z", "ABS_POLITIC")) + 
  labs(subtitle = f) + theme_minimal()

plot_model(m, type = "pred", terms = c("LIKE_Z", "ABS_POLITIC", "STIMULUS_CATEGORY")) + 
  labs(subtitle = f) + theme_minimal()
## Data were 'prettified'. Consider using `terms="LIKE_Z [all]"` to get
##   smooth plots.

plot_model(m, type = "pred", terms = c("ABS_POLITIC", "STIMULUS_CATEGORY","LIKE_Z")) + 
  labs(subtitle = f) + theme_minimal()
## Data were 'prettified'. Consider using `terms="ABS_POLITIC [all]"` to
##   get smooth plots.

## IN PAPER
tab_model(m)
  CHART ACTION 2
Predictors Odds Ratios CI p
(Intercept) 0.46 0.34 – 0.62 <0.001
STIMULUS CATEGORY [B] 1.20 0.82 – 1.74 0.345
STIMULUS CATEGORY [C] 1.95 1.34 – 2.85 0.001
STIMULUS CATEGORY [D] 2.21 1.52 – 3.21 <0.001
LIKE Z 3.15 2.65 – 3.75 <0.001
ABS POLITIC 1.54 1.32 – 1.81 <0.001
Random Effects
σ2 3.29
τ00 PID 1.12
ICC 0.25
N PID 318
Observations 1451
Marginal R2 / Conditional R2 0.276 / 0.461

CATEGORY, LIKE, POLITICS ABS

################## BUILD MODELS #################

# # RANDOM INTERCEPT SUBJECT
# mm.rP <- glmer(ENCOUNTER ~ (1|PID), data = df,family = "binomial")


# # SUBJECT INTERCEPT | FIXED BLOCK 
# ## should be non predictive
# print("ENCOUNTER ~ BLOCK + (1|PID)")
# mm.BrP <- glmer(ENCOUNTER ~ BLOCK + (1|PID), 
#                 data = df,family = "binomial")
# # :: TEST fixed factor 
# compare_performance(mm.rP, mm.BrP, rank = TRUE)
# paste("AIC with fixed effect is lower than random intercept only model?", AIC(logLik(mm.rP)) > AIC(logLik(mm.BrP)) )
# test_lrt(mm.rP,mm.BrP) #same as anova(m0, m1, test = "Chi")
# paste("Likelihood Ratio test is significant? p = ",(test_lrt(mm.rP,mm.BrP))$p[2])
# print("A model with BLOCK is NOT a better fit than (random effect) participant alone")
# car::Anova(mm.BrP, type=2)
# print("BLOCK is NOT significant predictor in the model")
# print("[this is as expected. suggests that we were successful in randomizing stimuli across the blocks]")

3.0.2 ENCOUNTER ~ CATEGORY

Are more figural (e.g. figures with more embellishments) graphs more likely to be interacted with than less figural graphs? To address this question, we explore the relationship between STIMULUS_CATEGORY and ENCOUNTER (whether they would likely scroll past and stop and look at the graph).

3.0.2.1 visualize

df <- df_graphs %>%
  ## FILTER OUT B0-0 COMMON STIMULUS (so cells can be balanced)
  filter(STIMULUS != "B0-0") %>% 
  select(STIMULUS, STIMULUS_CATEGORY, BLOCK, ENCOUNTER, CHART_LIKE, CHART_TRUST, PID) %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), #REVERSE FACTOR ORDER SO A IS REFERENCE
    ENCOUNTER = fct_rev(ENCOUNTER) #REVERSE SO SCROLL IS REFERENCE
    ## (only used if not filtering out B0-0)
    ## RECODE #recode b00 graph as category D [bc it fits in that category]
    # STIMULUS_CATEGORY = fct_recode(STIMULUS_CATEGORY, D="F") 
  ) %>% droplevels()

## CATEGORY
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = ENCOUNTER, y = STIMULUS_CATEGORY,
            results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) +
    theme_minimal() +
    labs( title = "ENCOUNTER by CATEGORY",  x = "", y="",
          subtitle = "the more figural categories (C,D) have a higher proportion of engagement") +
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################

## BLOCK
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = ENCOUNTER, y = BLOCK,
            results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) +
    theme_minimal() +
    labs( title = "ENCOUNTER by BLOCK",  x = "", y="",
          subtitle = "very little variance in proportion across blocks (as expected)") +
    theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

##############################



# BLOCK / CATEGORY
# GGSTATSPLOT
##############################
x <- grouped_ggbarstats( data = df, x = ENCOUNTER, y = BLOCK,   grouping.var=STIMULUS_CATEGORY,
                    results.subtitle = FALSE) + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) + 
    theme_minimal() +
    # labs( title = "",  x = "", y="") + 
    theme(aspect.ratio = 1) + easy_remove_legend()
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################

(x[[1]] + scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) + labs(title = "CATEGORY A", subtitle = "some variance across category") + 
x[[2]] + scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) + labs(title = "CATEGORY B", subtitle = "alot of variance across category")) / 
(x[[3]] + scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) + labs(title = "CATEGORY C", subtitle = "alot of variance across category") +
x[[4]] + scale_fill_manual(values = my_palettes(name="encounter", direction = "1")) + theme_ggstatsplot() + labs(title = "CATEGORY D", subtitle = "very little variance across category")) + plot_annotation(title = "ENCOUNTER by BLOCK and CATEGORY")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

INTERPRETATION _Here we see that when aggregated, it appears that more figural categories (C,D) have more engagement. However, when we visualize individual blocks (i.e. stimuli) within a particular category, we see a great deal of variance. This indicates that features of a particular stimulus may be stronger predictors of engagement than the degree of embellishment.

3.0.2.2 model fit

Is stimulus or category a better predictor of engagement? Here we fit a series of mixed effects logistic regression models, predicting ENCOUNTER (reference category = SCROLL) by STIMULUS_CATEGORY and BLOCK to determine if variance in encounter choice is best explained by the stimulus category (i.e. level of embellishment) or unique features of the stimulus (i.e. embellishment can be engaging or not engaging).

Parameter estimate: intercept = Log Odds of (SCROLL) responses in REFERENCE (exponetiate for odds) EB1 = Log Odds of ODDS of SCROLL response in CONTROL condition Parameter estimate: = Log Odds (Log OR; change in odds for correct response in impasse (vs) control [log scale]) = ODDS RATIO of correct response in IMPASSE (vs) CONTROL Null hypothesis: the odds for a correct response does not change, or decreases Alternative hypothesis: the odds of a correct response increases

3.0.2.2.1 DATA SETUP
df <- df_graphs %>%
  ## FILTER OUT B0-0 COMMON STIMULUS (so cells can be balanced)
  filter(STIMULUS != "B0-0") %>%
  select(STIMULUS, STIMULUS_CATEGORY, BLOCK, MAKER_ID, MAKER_GENDER, MAKER_AGE, ENCOUNTER, CHART_LIKE, CHART_TRUST, CHART_BEAUTY, MAKER_DESIGN, MAKER_ALIGN, CHART_INTENT, MAKER_TRUST, MAKER_DATA, MAKER_DESIGN, MAKER_ARGUE, MAKER_POLITIC, MAKER_SELF, PID) %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), #REVERSE FACTOR ORDER SO A IS REFERENCE
    ALIGN_Z = datawizard::standardise(MAKER_ALIGN),
    TRUST_Z = datawizard::standardise(CHART_TRUST),
    BEAUTY_Z = datawizard::standardise(CHART_BEAUTY),
    LIKE_Z = datawizard::standardise(CHART_LIKE),
    INTENT_Z = datawizard::standardise(CHART_INTENT),
    MAKERTRUST_Z = datawizard::standardise(MAKER_TRUST),
    DESIGN_Z = datawizard::standardise(MAKER_DESIGN),
    DATA_Z = datawizard::standardise(MAKER_DATA),
    ARGUE_Z = datawizard::standardise(MAKER_ARGUE),
    SELF_Z = datawizard::standardise(MAKER_SELF),
    ABS_POLITIC = datawizard::standardize(abs(MAKER_POLITIC - 50)) #standardize after halfving scale 
  ) %>% 
  droplevels()
    
  
    ## (only used if NOT filtering out B0-0)
    ## RECODE #recode b00 graph as category D [bc it fits in that category]
    # STIMULUS_CATEGORY = fct_recode(STIMULUS_CATEGORY, D="F") 
################## BUILD MODELS #################

# # RANDOM INTERCEPT SUBJECT
# mm.rP <- glmer(ENCOUNTER ~ (1|PID), data = df,family = "binomial")


# # SUBJECT INTERCEPT | FIXED BLOCK 
# ## should be non predictive
# print("ENCOUNTER ~ BLOCK + (1|PID)")
# mm.BrP <- glmer(ENCOUNTER ~ BLOCK + (1|PID), 
#                 data = df,family = "binomial")
# # :: TEST fixed factor 
# compare_performance(mm.rP, mm.BrP, rank = TRUE)
# paste("AIC with fixed effect is lower than random intercept only model?", AIC(logLik(mm.rP)) > AIC(logLik(mm.BrP)) )
# test_lrt(mm.rP,mm.BrP) #same as anova(m0, m1, test = "Chi")
# paste("Likelihood Ratio test is significant? p = ",(test_lrt(mm.rP,mm.BrP))$p[2])
# print("A model with BLOCK is NOT a better fit than (random effect) participant alone")
# car::Anova(mm.BrP, type=2)
# print("BLOCK is NOT significant predictor in the model")
# print("[this is as expected. suggests that we were successful in randomizing stimuli across the blocks]")
3.0.2.2.2 ENCOUNTER ~ CATEOGRY
### REFERENCE LEVEL OF ENCOUNTER (0 == ENGAGE)
### STIMULUS CATEGORY A B C D


################## ENCOUNTER ~ CATEGORY #################
f.CrP <-  "ENCOUNTER ~ STIMULUS_CATEGORY + (1|PID)"
mm.CrP <- glmer(ENCOUNTER ~ STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.CrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                    Chisq Df     Pr(>Chisq)    
## STIMULUS_CATEGORY 44.828  3 0.000000001007 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.CrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1700.7   1726.4   -845.3   1690.7     1267 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.4699 -0.9513  0.6803  0.7432  1.0925 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.04003  0.2001  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)         -0.1272     0.1135  -1.121       0.262    
## STIMULUS_CATEGORYB   0.0764     0.1596   0.479       0.632    
## STIMULUS_CATEGORYC   0.7705     0.1645   4.683 0.000002827 ***
## STIMULUS_CATEGORYD   0.8702     0.1661   5.238 0.000000162 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## STIMULUS_CATEGORYB -0.704                                      
## STIMULUS_CATEGORYC -0.685  0.487                               
## STIMULUS_CATEGORYD -0.679  0.482              0.478
performance(mm.CrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log
## -------------------------------------------------------------------------------------------------------
## 1700.695 | 1700.742 | 1726.437 |      0.056 |      0.044 | 0.012 | 0.481 | 1.000 |    0.655 |      -Inf
m <- mm.CrP
f <- f.CrP
## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = "STIMULUS_CATEGORY") + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
# tab_model(m)

EMBELLISHMENT CATEGORY is significant predictor, predicts 5% variance in ENCOUNTER choice, with only categories C,D significantly different.

3.0.2.2.3 ENCOUNTER ~ BEAUTY
################## ENCOUNTER ~ BEAUTY #################
f.BrP <-  "ENCOUNTER ~ BEAUTY + (1|PID)"
mm.BrP <- glmer(ENCOUNTER ~ BEAUTY_Z + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.BrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##          Chisq Df            Pr(>Chisq)    
## BEAUTY_Z 145.1  1 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.BrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ BEAUTY_Z + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1540.7   1556.1   -767.3   1534.7     1269 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7407 -0.7897  0.4425  0.7046  1.9046 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.1986   0.4456  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##             Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)   0.3453     0.0684   5.049          0.000000444 ***
## BEAUTY_Z      0.9154     0.0760  12.046 < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##          (Intr)
## BEAUTY_Z 0.130
performance(mm.BrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1540.675 | 1540.694 | 1556.120 |      0.240 |      0.194 | 0.057 | 0.439 | 1.000 |    0.567 |      -Inf |           0.001
m <- mm.BrP
f <- f.BrP
## REPORT 
# report(mm.CrP)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = "BEAUTY_Z") + 
  labs(subtitle = f) + theme_minimal()
## Data were 'prettified'. Consider using `terms="BEAUTY_Z [all]"` to get
##   smooth plots.

## IN PAPER
# tab_model(mm.I)

BEAUTY is significant predictor, predicts 19% variance in ENCOUNTER choice. Beauty increases probability of scroll, 2.5X the odds for 1 SD in increase in beauty

3.0.2.2.4 ENCOUNTER ~ LIKE
################## ENCOUNTER ~ LIKE #################
f.LrP <-  "ENCOUNTER ~ LIKE + (1|PID)"
mm.LrP <- glmer(ENCOUNTER ~ LIKE_Z + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.LrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##         Chisq Df            Pr(>Chisq)    
## LIKE_Z 170.85  1 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.LrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1484.6   1500.0   -739.3   1478.6     1269 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7941 -0.7674  0.3865  0.6757  2.3098 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.1945   0.441   
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##             Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)  0.35708    0.06977   5.118          0.000000309 ***
## LIKE_Z       1.06868    0.08176  13.071 < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##        (Intr)
## LIKE_Z 0.139
performance(mm.LrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1484.565 | 1484.584 | 1500.010 |      0.289 |      0.247 | 0.056 | 0.429 | 1.000 |    0.547 |      -Inf |       7.866e-04
m <- mm.LrP
f <- f.LrP
## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = "LIKE_Z") +
  labs(subtitle = f) + theme_minimal()
## Data were 'prettified'. Consider using `terms="LIKE_Z [all]"` to get
##   smooth plots.

## IN PAPER
# tab_model(mm.I)

LIKE is significant predictor, accounts 25% variance , 2.9X ODDS INCREASE ON LIKE

3.0.2.2.5 compare
compare_performance(mm.CrP, mm.BrP, mm.LrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma,
##   Score_spherical
## # Comparison of Model Performance Indices
## 
## Name   |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | AIC weights | AICc weights | BIC weights | Performance-Score
## ---------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.CrP | glmerMod |      0.056 |      0.044 | 0.012 | 0.481 | 1.000 |    0.655 |      -Inf |    1.17e-47 |     1.15e-47 |    6.79e-50 |             -Inf%
## mm.BrP | glmerMod |      0.240 |      0.194 | 0.057 | 0.439 | 1.000 |    0.567 |      -Inf |    6.54e-13 |     6.54e-13 |    6.54e-13 |             -Inf%
## mm.LrP | glmerMod |      0.289 |      0.247 | 0.056 | 0.429 | 1.000 |    0.547 |      -Inf |       1.000 |        1.000 |       1.000 |             -Inf%
anova(mm.CrP, mm.BrP, mm.LrP)
## Data: df
## Models:
## mm.BrP: ENCOUNTER ~ BEAUTY_Z + (1 | PID)
## mm.LrP: ENCOUNTER ~ LIKE_Z + (1 | PID)
## mm.CrP: ENCOUNTER ~ STIMULUS_CATEGORY + (1 | PID)
##        npar    AIC    BIC  logLik deviance Chisq Df Pr(>Chisq)
## mm.BrP    3 1540.7 1556.1 -767.34   1534.7                    
## mm.LrP    3 1484.6 1500.0 -739.28   1478.6 56.11  0           
## mm.CrP    5 1700.7 1726.4 -845.35   1690.7  0.00  2          1
3.0.2.2.6 ENCOUNTER ~ CATEGORY + BEAUTY
################## ENCOUNTER ~ CATEGORY + BEAUTY #################
f.BCrP <-  "ENCOUNTER ~ BEAUTY + CATEGORY+ (1|PID)"
mm.BCrP <- glmer(ENCOUNTER ~ BEAUTY_Z + STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.BCrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                     Chisq Df            Pr(>Chisq)    
## BEAUTY_Z          134.227  1 < 0.00000000000000022 ***
## STIMULUS_CATEGORY  25.969  3           0.000009682 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.BCrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ BEAUTY_Z + STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1520.2   1551.1   -754.1   1508.2     1266 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7977 -0.7783  0.4008  0.6990  2.0928 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2333   0.483   
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)        -0.05442    0.12707  -0.428             0.668434    
## BEAUTY_Z            0.89353    0.07712  11.586 < 0.0000000000000002 ***
## STIMULUS_CATEGORYB  0.18526    0.17516   1.058             0.290206    
## STIMULUS_CATEGORYC  0.70275    0.18113   3.880             0.000105 ***
## STIMULUS_CATEGORYD  0.76467    0.18225   4.196            0.0000272 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) BEAUTY STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## BEAUTY_Z            0.024                                             
## STIMULUS_CATEGORYB -0.690  0.063                                      
## STIMULUS_CATEGORYC -0.670  0.047  0.489                               
## STIMULUS_CATEGORYD -0.667  0.028  0.485              0.477
performance(mm.BCrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1520.184 | 1520.250 | 1551.074 |      0.272 |      0.221 | 0.066 | 0.432 | 1.000 |    0.552 |      -Inf |       8.195e-04
m <- mm.BCrP
f <- f.BCrP
## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "BEAUTY_Z")) + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
# tab_model(mm.I)

sig main effects , explains 22% variance

3.0.2.2.7 (BEST) ENCOUNTER ~ CATEGORY + LIKE
################## ENCOUNTER ~ CATEGORY + LIKE #################
f.LCrP <-  "ENCOUNTER ~ LIKE + CATEGORY+ (1|PID)"
mm.LCrP <- glmer(ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.LCrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                     Chisq Df            Pr(>Chisq)    
## LIKE_Z            165.527  1 < 0.00000000000000022 ***
## STIMULUS_CATEGORY  36.589  3         0.00000005623 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.LCrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1452.5   1483.4   -720.2   1440.5     1266 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.4469 -0.7325  0.3478  0.6628  2.6482 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2519   0.5019  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)        -0.10712    0.13061  -0.820                0.412    
## LIKE_Z              1.08707    0.08449  12.866 < 0.0000000000000002 ***
## STIMULUS_CATEGORYB  0.17751    0.17956   0.989                0.323    
## STIMULUS_CATEGORYC  0.85650    0.18837   4.547           0.00000544 ***
## STIMULUS_CATEGORYD  0.91550    0.18837   4.860           0.00000117 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) LIKE_Z STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## LIKE_Z             -0.020                                             
## STIMULUS_CATEGORYB -0.694  0.051                                      
## STIMULUS_CATEGORYC -0.665  0.131  0.488                               
## STIMULUS_CATEGORYD -0.664  0.108  0.487              0.479
performance(mm.LCrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1452.462 | 1452.528 | 1483.352 |      0.338 |      0.287 | 0.071 | 0.418 | 1.000 |    0.525 |      -Inf |       7.870e-04
m <- mm.LCrP
f <- f.LCrP
## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z")) + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
tab_model(m)
  ENCOUNTER
Predictors Odds Ratios CI p
(Intercept) 0.90 0.70 – 1.16 0.412
LIKE Z 2.97 2.51 – 3.50 <0.001
STIMULUS CATEGORY [B] 1.19 0.84 – 1.70 0.323
STIMULUS CATEGORY [C] 2.35 1.63 – 3.41 <0.001
STIMULUS CATEGORY [D] 2.50 1.73 – 3.61 <0.001
Random Effects
σ2 3.29
τ00 PID 0.25
ICC 0.07
N PID 318
Observations 1272
Marginal R2 / Conditional R2 0.287 / 0.338

Linear combination of LIKE and CATEGORY predicts 28.7% variance, significant like, sig on categories C and D, 3X odds increase on like, ~2.3 - 2.5 on B and C

3.0.2.2.8 compare
### compare
compare_performance(mm.LCrP, mm.BCrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma
## # Comparison of Model Performance Indices
## 
## Name    |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical | AIC weights | AICc weights | BIC weights | Performance-Score
## ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.LCrP | glmerMod |      0.338 |      0.287 | 0.071 | 0.418 | 1.000 |    0.525 |      -Inf |       7.870e-04 |       1.000 |        1.000 |       1.000 |             -Inf%
## mm.BCrP | glmerMod |      0.272 |      0.221 | 0.066 | 0.432 | 1.000 |    0.552 |      -Inf |       8.195e-04 |    1.97e-15 |     1.97e-15 |    1.97e-15 |             -Inf%
anova(mm.BrP, mm.LCrP, mm.BCrP)
## Data: df
## Models:
## mm.BrP: ENCOUNTER ~ BEAUTY_Z + (1 | PID)
## mm.LCrP: ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + (1 | PID)
## mm.BCrP: ENCOUNTER ~ BEAUTY_Z + STIMULUS_CATEGORY + (1 | PID)
##         npar    AIC    BIC  logLik deviance  Chisq Df            Pr(>Chisq)    
## mm.BrP     3 1540.7 1556.1 -767.34   1534.7                                    
## mm.LCrP    6 1452.5 1483.3 -720.23   1440.5 94.213  3 < 0.00000000000000022 ***
## mm.BCrP    6 1520.2 1551.1 -754.09   1508.2  0.000  0                          
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Like + category is better than beauty + category

3.0.2.3 maximal kinda

Since the encounter choice occurred at first exposure to the stimulus we limited our comparisons to the types of social attribution we thought most psychologically-plausible to impact early cognitive processes like attention allocation: , , measures we thought most likely to impact a volitional choice including: and , as well as measures shown in prior work to affect attention via visual salience, including: and ~, and degree of embellishment via . T

#BLOCK, MAKER_ID, MAKER_GENDER, MAKER_AGE, ENCOUNTER, CHART_LIKE, CHART_TRUST, CHART_BEAUTY, MAKER_DESIGN, MAKER_ALIGN, CHART_INTENT, MAKER_DATA, MAKER_DESIGN, PID
################## ENCOUNTER ~ CATEGORY * LIKE #################
# f.LxCrP <-  "ENCOUNTER ~ LIKE + CATEGORY + (1|PID)"
# mm <- glmer(ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + MAKER_ID +  MAKER_GENDER + MAKER_AGE + TRUST_Z + BEAUTY_Z + INTENT_Z + DESIGN_Z + DATA_Z + ALIGN_Z  + ARGUE_Z + SELF_Z + (1|PID), 
mm <- glmer(ENCOUNTER ~ DESIGN_Z + INTENT_Z + MAKERTRUST_Z + DATA_Z +  BEAUTY_Z + LIKE_Z + STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial",
             control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
               optCtrl=list(maxfun=2e5)))
car::Anova(mm, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                     Chisq Df          Pr(>Chisq)    
## DESIGN_Z           1.4193  1           0.2335166    
## INTENT_Z           3.7697  1           0.0521877 .  
## MAKERTRUST_Z       0.2093  1           0.6473466    
## DATA_Z             0.3558  1           0.5508468    
## BEAUTY_Z           0.4755  1           0.4904847    
## LIKE_Z            57.7225  1 0.00000000000003018 ***
## STIMULUS_CATEGORY 18.1145  3           0.0004166 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ DESIGN_Z + INTENT_Z + MAKERTRUST_Z + DATA_Z + BEAUTY_Z +  
##     LIKE_Z + STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 200000))
## 
##      AIC      BIC   logLik deviance df.resid 
##   1454.9   1511.6   -716.5   1432.9     1261 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3482 -0.7417  0.3413  0.6609  2.9733 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2706   0.5202  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error z value           Pr(>|z|)    
## (Intercept)        -0.003394   0.139261  -0.024           0.980557    
## DESIGN_Z           -0.101072   0.084838  -1.191           0.233517    
## INTENT_Z            0.164302   0.084623   1.942           0.052188 .  
## MAKERTRUST_Z        0.041715   0.091191   0.457           0.647347    
## DATA_Z              0.050901   0.085334   0.596           0.550847    
## BEAUTY_Z            0.084302   0.122258   0.690           0.490485    
## LIKE_Z              1.030384   0.135621   7.598 0.0000000000000302 ***
## STIMULUS_CATEGORYB  0.140595   0.182351   0.771           0.440700    
## STIMULUS_CATEGORYC  0.705260   0.200864   3.511           0.000446 ***
## STIMULUS_CATEGORYD  0.700830   0.210604   3.328           0.000876 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) DESIGN INTENT MAKERT DATA_Z BEAUTY LIKE_Z
## DESIGN_Z           -0.181                                          
## INTENT_Z            0.128  0.112                                   
## MAKERTRUST_        -0.021 -0.010  0.360                            
## DATA_Z              0.205 -0.405 -0.179  0.184                     
## BEAUTY_Z            0.007  0.235 -0.006  0.051 -0.077              
## LIKE_Z              0.024 -0.056  0.088 -0.257  0.055 -0.709       
## STIMULUS_CATEGORYB -0.687  0.053 -0.035  0.022 -0.092  0.044 -0.022
## STIMULUS_CATEGORYC -0.697  0.099 -0.143  0.065 -0.196 -0.035  0.034
## STIMULUS_CATEGORYD -0.705  0.303 -0.137  0.023 -0.276  0.002  0.023
##                    STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## DESIGN_Z                                                
## INTENT_Z                                                
## MAKERTRUST_                                             
## DATA_Z                                                  
## BEAUTY_Z                                                
## LIKE_Z                                                  
## STIMULUS_CATEGORYB                                      
## STIMULUS_CATEGORYC  0.496                               
## STIMULUS_CATEGORYD  0.483              0.538
performance(mm)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1454.921 | 1455.131 | 1511.553 |      0.349 |      0.295 | 0.076 | 0.416 | 1.000 |    0.520 |      -Inf |       7.862e-04
m <- mm
f <- mm

### compare
# compare_performance(mm.CrP, mm.LrP, mm.LCrP, mm.LxCrP, rank = TRUE)
# anova(mm.LCrP, mm.LxCrP)


## REPORT 
# report(m)

## PLOT COEF
plot_model(mm, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) #+

  labs(subtitle = f) + theme_minimal()
## NULL
## PLOT PRED (only sig model terms)
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z"))

plot_model(m, type = "pred", terms = c("LIKE_Z", "STIMULUS_CATEGORY"))
## Data were 'prettified'. Consider using `terms="LIKE_Z [all]"` to get
##   smooth plots.

##HAVE TERMS NOT IN MODEL
# plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z", "MAKER_ID"))
# plot_model(m, type = "pred", terms = c("LIKE_Z", "STIMULUS_CATEGORY", "MAKER_ID"))
# plot_model(m, type = "pred", terms = c("LIKE_Z", "STIMULUS_CATEGORY", "MAKER_ID", " MAKER_AGE"))

##+ 
  # labs(subtitle = f) + theme_minimal()

## IN PAPER
tab_model(mm)
  ENCOUNTER
Predictors Odds Ratios CI p
(Intercept) 1.00 0.76 – 1.31 0.981
DESIGN Z 0.90 0.77 – 1.07 0.234
INTENT Z 1.18 1.00 – 1.39 0.052
MAKERTRUST Z 1.04 0.87 – 1.25 0.647
DATA Z 1.05 0.89 – 1.24 0.551
BEAUTY Z 1.09 0.86 – 1.38 0.490
LIKE Z 2.80 2.15 – 3.66 <0.001
STIMULUS CATEGORY [B] 1.15 0.81 – 1.65 0.441
STIMULUS CATEGORY [C] 2.02 1.37 – 3.00 <0.001
STIMULUS CATEGORY [D] 2.02 1.33 – 3.05 0.001
Random Effects
σ2 3.29
τ00 PID 0.27
ICC 0.08
N PID 318
Observations 1272
Marginal R2 / Conditional R2 0.295 / 0.349
3.0.2.3.1 fish
#BLOCK, MAKER_ID, MAKER_GENDER, MAKER_AGE, ENCOUNTER, CHART_LIKE, CHART_TRUST, CHART_BEAUTY, MAKER_DESIGN, MAKER_ALIGN, CHART_INTENT, MAKER_DATA, MAKER_DESIGN, PID
################## ENCOUNTER ~ CATEGORY * LIKE #################
# f.LxCrP <-  "ENCOUNTER ~ LIKE + CATEGORY + (1|PID)"
# mm <- glmer(ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + MAKER_ID +  MAKER_GENDER + MAKER_AGE + TRUST_Z + BEAUTY_Z + INTENT_Z + DESIGN_Z + DATA_Z + ALIGN_Z  + ARGUE_Z + SELF_Z + (1|PID), 
mm <- glmer(ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + MAKER_ID +  MAKER_AGE + (1|PID), 
                data = df,family = "binomial",
             control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
               optCtrl=list(maxfun=2e5)))
car::Anova(mm, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                     Chisq Df            Pr(>Chisq)    
## LIKE_Z            131.722  1 < 0.00000000000000022 ***
## STIMULUS_CATEGORY  23.126  3            0.00003802 ***
## MAKER_ID           13.691  5               0.01770 *  
## MAKER_AGE          10.850  3               0.01256 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + MAKER_ID + MAKER_AGE +  
##     (1 | PID)
##    Data: df
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 200000))
## 
##      AIC      BIC   logLik deviance df.resid 
##   1441.2   1513.3   -706.6   1413.2     1258 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3432 -0.7192  0.3305  0.6535  3.3026 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2074   0.4555  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                      Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)          -0.78981    0.35816  -2.205             0.027440 *  
## LIKE_Z                0.99474    0.08667  11.477 < 0.0000000000000002 ***
## STIMULUS_CATEGORYB    0.14118    0.18586   0.760             0.447499    
## STIMULUS_CATEGORYC    0.79223    0.20868   3.796             0.000147 ***
## STIMULUS_CATEGORYD    0.76755    0.20099   3.819             0.000134 ***
## MAKER_IDorganization  0.26665    0.37449   0.712             0.476448    
## MAKER_IDeducation     0.27863    0.29373   0.949             0.342831    
## MAKER_IDbusiness     -0.07427    0.29948  -0.248             0.804149    
## MAKER_IDnews          0.70112    0.30007   2.337             0.019463 *  
## MAKER_IDpolitical     0.29449    0.29817   0.988             0.323323    
## MAKER_AGEgen-x        0.47390    0.22411   2.115             0.034465 *  
## MAKER_AGEmillennial   0.69315    0.23962   2.893             0.003820 ** 
## MAKER_AGEgen-z        0.08844    0.35184   0.251             0.801531    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation matrix not shown by default, as p = 13 > 12.
## Use print(x, correlation=TRUE)  or
##     vcov(x)        if you need it
performance(mm)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1441.189 | 1441.523 | 1513.266 |      0.352 |      0.311 | 0.059 | 0.417 | 1.000 |    0.521 |      -Inf |       9.710e-04
m <- mm
f <- mm

### compare
# compare_performance(mm.CrP, mm.LrP, mm.LCrP, mm.LxCrP, rank = TRUE)
# anova(mm.LCrP, mm.LxCrP)


## REPORT 
# report(m)

## PLOT COEF
plot_model(mm, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) #+

  labs(subtitle = f) + theme_minimal()
## NULL
## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z", "MAKER_ID"))

plot_model(m, type = "pred", terms = c("LIKE_Z", "STIMULUS_CATEGORY", "MAKER_ID"))
## Data were 'prettified'. Consider using `terms="LIKE_Z [all]"` to get
##   smooth plots.

plot_model(m, type = "pred", terms = c("LIKE_Z", "STIMULUS_CATEGORY", "MAKER_ID", " MAKER_AGE"))
## Data were 'prettified'. Consider using `terms="LIKE_Z [all]"` to get
##   smooth plots.

##+ 
  labs(subtitle = f) + theme_minimal()
## NULL
## IN PAPER
tab_model(mm)
  ENCOUNTER
Predictors Odds Ratios CI p
(Intercept) 0.45 0.22 – 0.92 0.027
LIKE Z 2.70 2.28 – 3.20 <0.001
STIMULUS CATEGORY [B] 1.15 0.80 – 1.66 0.447
STIMULUS CATEGORY [C] 2.21 1.47 – 3.32 <0.001
STIMULUS CATEGORY [D] 2.15 1.45 – 3.19 <0.001
MAKER ID [organization] 1.31 0.63 – 2.72 0.476
MAKER ID [education] 1.32 0.74 – 2.35 0.343
MAKER ID [business] 0.93 0.52 – 1.67 0.804
MAKER ID [news] 2.02 1.12 – 3.63 0.019
MAKER ID [political] 1.34 0.75 – 2.41 0.323
MAKER AGE [gen-x] 1.61 1.04 – 2.49 0.034
MAKER AGE [millennial] 2.00 1.25 – 3.20 0.004
MAKER AGE [gen-z] 1.09 0.55 – 2.18 0.802
Random Effects
σ2 3.29
τ00 PID 0.21
ICC 0.06
N PID 318
Observations 1272
Marginal R2 / Conditional R2 0.311 / 0.352

best fitting model contained encounter ~ like + category + maker_id, explained 30% variance, 3 sig predictors A MODEL adding maker age explains 33% variance

3.0.2.3.2 (no) ENCOUNTER ~ CATEGORY X LIKE
################## ENCOUNTER ~ CATEGORY * LIKE #################
f.LxCrP <-  "ENCOUNTER ~ LIKE * CATEGORY + (1|PID)"
mm.LxCrP <- glmer(ENCOUNTER ~ LIKE_Z * STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.LxCrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                             Chisq Df            Pr(>Chisq)    
## LIKE_Z                   165.0546  1 < 0.00000000000000022 ***
## STIMULUS_CATEGORY         36.3762  3         0.00000006235 ***
## LIKE_Z:STIMULUS_CATEGORY   0.4597  3                0.9277    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.LxCrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z * STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1458.0   1504.3   -720.0   1440.0     1263 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6824 -0.7402  0.3396  0.6704  2.6628 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2552   0.5051  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                            Estimate Std. Error z value         Pr(>|z|)    
## (Intercept)               -0.107284   0.130771  -0.820            0.412    
## LIKE_Z                     1.091245   0.157349   6.935 0.00000000000406 ***
## STIMULUS_CATEGORYB         0.170822   0.179115   0.954            0.340    
## STIMULUS_CATEGORYC         0.857836   0.190028   4.514 0.00000635391968 ***
## STIMULUS_CATEGORYD         0.925369   0.190550   4.856 0.00000119597977 ***
## LIKE_Z:STIMULUS_CATEGORYB -0.083387   0.217885  -0.383            0.702    
## LIKE_Z:STIMULUS_CATEGORYC  0.002008   0.210321   0.010            0.992    
## LIKE_Z:STIMULUS_CATEGORYD  0.062849   0.217497   0.289            0.773    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                           (Intr) LIKE_Z STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## LIKE_Z                    -0.024                                             
## STIMULUS_CATEGORYB        -0.696  0.020                                      
## STIMULUS_CATEGORYC        -0.659  0.037  0.482                               
## STIMULUS_CATEGORYD        -0.657  0.037  0.481              0.466            
## LIKE_Z:STIMULUS_CATEGORYB  0.014 -0.690  0.043             -0.006            
## LIKE_Z:STIMULUS_CATEGORYC  0.013 -0.704 -0.010              0.097            
## LIKE_Z:STIMULUS_CATEGORYD  0.012 -0.685 -0.009             -0.001            
##                           STIMULUS_CATEGORYD LIKE_Z:STIMULUS_CATEGORYB
## LIKE_Z                                                                
## STIMULUS_CATEGORYB                                                    
## STIMULUS_CATEGORYC                                                    
## STIMULUS_CATEGORYD                                                    
## LIKE_Z:STIMULUS_CATEGORYB -0.008                                      
## LIKE_Z:STIMULUS_CATEGORYC -0.004              0.513                   
## LIKE_Z:STIMULUS_CATEGORYD  0.079              0.504                   
##                           LIKE_Z:STIMULUS_CATEGORYC
## LIKE_Z                                             
## STIMULUS_CATEGORYB                                 
## STIMULUS_CATEGORYC                                 
## STIMULUS_CATEGORYD                                 
## LIKE_Z:STIMULUS_CATEGORYB                          
## LIKE_Z:STIMULUS_CATEGORYC                          
## LIKE_Z:STIMULUS_CATEGORYD  0.523
performance(mm.LxCrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1458.003 | 1458.146 | 1504.338 |      0.340 |      0.289 | 0.072 | 0.418 | 1.000 |    0.524 |      -Inf |       7.868e-04
m <- mm.LxCrP
f <- f.LxCrP

### compare
# compare_performance(mm.CrP, mm.LrP, mm.LCrP, mm.LxCrP, rank = TRUE)
# anova(mm.LCrP, mm.LxCrP)


## REPORT 
# report(m)

## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z")) + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
# tab_model(mm.I)

main effects but interaction is not significant and interaction is not a better fit

3.0.2.3.3 (no) ENCOUNTER ~ CATEGORY + LIKE + ALIGN
################## ENCOUNTER ~ CATEGORY + LIKE + ALIGN #################
f.ALCrP <-  "ENCOUNTER ~ LIKE + CATEGORY + ALIGN (1|PID)"
mm.ALCrP <- glmer(ENCOUNTER ~ LIKE_Z + ALIGN_Z + STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.ALCrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                      Chisq Df            Pr(>Chisq)    
## LIKE_Z            127.5796  1 < 0.00000000000000022 ***
## ALIGN_Z             0.4421  1                0.5061    
## STIMULUS_CATEGORY  36.8719  3         0.00000004898 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.ALCrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z + ALIGN_Z + STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1454.0   1490.1   -720.0   1440.0     1265 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3631 -0.7447  0.3515  0.6647  2.5971 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2543   0.5042  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)        -0.11580    0.13122  -0.882                0.378    
## LIKE_Z              1.05916    0.09377  11.295 < 0.0000000000000002 ***
## ALIGN_Z             0.05528    0.08314   0.665                0.506    
## STIMULUS_CATEGORYB  0.18441    0.17977   1.026                0.305    
## STIMULUS_CATEGORYC  0.87605    0.19101   4.586          0.000004508 ***
## STIMULUS_CATEGORYD  0.92806    0.18943   4.899          0.000000962 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) LIKE_Z ALIGN_ STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## LIKE_Z              0.026                                                    
## ALIGN_Z            -0.101 -0.433                                             
## STIMULUS_CATEGORYB -0.695  0.020  0.059                                      
## STIMULUS_CATEGORYC -0.668  0.048  0.159  0.489                               
## STIMULUS_CATEGORYD -0.667  0.051  0.105  0.489              0.486
performance(mm.ALCrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1454.019 | 1454.108 | 1490.057 |      0.339 |      0.288 | 0.072 | 0.418 | 1.000 |    0.524 |      -Inf |       9.727e-04
m <- mm.ALCrP
f <- f.ALCrP
## REPORT 
# report(m)


## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z", "ALIGN_Z")) + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
# tab_model(mm.I)

compare_performance(mm.LCrP, mm.ALCrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma
## # Comparison of Model Performance Indices
## 
## Name     |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.LCrP  | glmerMod |      0.338 |      0.287 | 0.071 | 0.418 | 1.000 |    0.525 |      -Inf |       7.870e-04 |       0.685 |        0.688 |       0.966 |             -Inf%
## mm.ALCrP | glmerMod |      0.339 |      0.288 | 0.072 | 0.418 | 1.000 |    0.524 |      -Inf |       9.727e-04 |       0.315 |        0.312 |       0.034 |             -Inf%
anova(mm.LCrP, mm.ALCrP)
## Data: df
## Models:
## mm.LCrP: ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + (1 | PID)
## mm.ALCrP: ENCOUNTER ~ LIKE_Z + ALIGN_Z + STIMULUS_CATEGORY + (1 | PID)
##          npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)
## mm.LCrP     6 1452.5 1483.3 -720.23   1440.5                     
## mm.ALCrP    7 1454.0 1490.1 -720.01   1440.0 0.4426  1     0.5059
3.0.2.3.4 ENCOUNTER ~ CATEGORY + LIKE + TRUST
################## ENCOUNTER ~ CATEGORY + LIKE + TRUST #################
f.TLCrP <-  "ENCOUNTER ~ LIKE + CATEGORY + TRUST (1|PID)"
mm.TLCrP <- glmer(ENCOUNTER ~ LIKE_Z + TRUST_Z + STIMULUS_CATEGORY + (1|PID), 
                data = df,family = "binomial")
car::Anova(mm.TLCrP, type = 2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: ENCOUNTER
##                      Chisq Df            Pr(>Chisq)    
## LIKE_Z            133.1684  1 < 0.00000000000000022 ***
## TRUST_Z             2.2556  1                0.1331    
## STIMULUS_CATEGORY  29.3599  3           0.000001881 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mm.TLCrP)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ LIKE_Z + TRUST_Z + STIMULUS_CATEGORY + (1 | PID)
##    Data: df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1452.2   1488.2   -719.1   1438.2     1265 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5506 -0.7415  0.3481  0.6600  3.0911 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.2363   0.4861  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                    Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)        -0.07058    0.13293  -0.531                0.595    
## LIKE_Z              1.16639    0.10107  11.540 < 0.0000000000000002 ***
## TRUST_Z            -0.13420    0.08936  -1.502                0.133    
## STIMULUS_CATEGORYB  0.15622    0.18056   0.865                0.387    
## STIMULUS_CATEGORYC  0.78802    0.19294   4.084            0.0000442 ***
## STIMULUS_CATEGORYD  0.84948    0.19306   4.400            0.0000108 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                    (Intr) LIKE_Z TRUST_ STIMULUS_CATEGORYB STIMULUS_CATEGORYC
## LIKE_Z              0.082                                                    
## TRUST_Z            -0.178 -0.553                                             
## STIMULUS_CATEGORYB -0.696  0.000  0.076                                      
## STIMULUS_CATEGORYC -0.682 -0.018  0.225  0.494                               
## STIMULUS_CATEGORYD -0.679 -0.031  0.216  0.492              0.507
performance(mm.TLCrP)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical
## -------------------------------------------------------------------------------------------------------------------------
## 1452.194 | 1452.282 | 1488.232 |      0.337 |      0.289 | 0.067 | 0.419 | 1.000 |    0.526 |      -Inf |       7.888e-04
m <- mm.TLCrP
f <- f.TLCrP
## REPORT 
# report(m)


## PLOT COEF
plot_model(m, type = "est", vline.color = "red", show.intercept = TRUE, show.values = TRUE) + 
  labs(subtitle = f) + theme_minimal()

## PLOT PRED
plot_model(m, type = "pred", terms = c("STIMULUS_CATEGORY", "LIKE_Z", "TRUST_Z")) + 
  labs(subtitle = f) + theme_minimal()

## IN PAPER
# tab_model(mm.I)

compare_performance(mm.TLCrP, mm.LCrP, mm.ALCrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma
## # Comparison of Model Performance Indices
## 
## Name     |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.TLCrP | glmerMod |      0.337 |      0.289 | 0.067 | 0.419 | 1.000 |    0.526 |      -Inf |       7.888e-04 |       0.439 |        0.437 |       0.078 |             -Inf%
## mm.LCrP  | glmerMod |      0.338 |      0.287 | 0.071 | 0.418 | 1.000 |    0.525 |      -Inf |       7.870e-04 |       0.384 |        0.387 |       0.891 |             -Inf%
## mm.ALCrP | glmerMod |      0.339 |      0.288 | 0.072 | 0.418 | 1.000 |    0.524 |      -Inf |       9.727e-04 |       0.176 |        0.176 |       0.031 |             -Inf%
anova(mm.TLCrP, mm.LCrP, mm.ALCrP)
## Data: df
## Models:
## mm.LCrP: ENCOUNTER ~ LIKE_Z + STIMULUS_CATEGORY + (1 | PID)
## mm.TLCrP: ENCOUNTER ~ LIKE_Z + TRUST_Z + STIMULUS_CATEGORY + (1 | PID)
## mm.ALCrP: ENCOUNTER ~ LIKE_Z + ALIGN_Z + STIMULUS_CATEGORY + (1 | PID)
##          npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)
## mm.LCrP     6 1452.5 1483.3 -720.23   1440.5                     
## mm.TLCrP    7 1452.2 1488.2 -719.10   1438.2 2.2678  1     0.1321
## mm.ALCrP    7 1454.0 1490.1 -720.01   1440.0 0.0000  0

trust not sig, model not better

3.0.2.3.5 block * category <– stimulus
# 
# # SUBJECT INTERCEPT | FIXED CATEGORY + BLOCK
# print("ENCOUNTER ~ CATEGORY + BLOCK + (1|PID)")
# mm.C_BrP <- glmer(ENCOUNTER ~ STIMULUS_CATEGORY + BLOCK + (1|PID), 
#                 data = df,family = "binomial")
# # :: TEST fixed factor 
# compare_performance(mm.rP, mm.BrP, mm.CrP, mm.C_BrP, rank = TRUE)
# ##anova instead of LRT b/c models are not nested 
# anova(mm.CrP,mm.C_BrP) #same as anova(m0, m1, test = "Chi")
# test_lrt(mm.CrP, mm.C_BrP)
# paste("A model with a linear combination of CATEGORY and BLOCK predicting ENCOUNTER is NOT better fit than a model with only CATEGORY.")
# car::Anova(mm.C_BrP, type = 3)
# print("CATEGORY is a significant predictor in this model, but BLOCK is not")
# 
# 
# # SUBJECT INTERCEPT | FIXED BLOCK * CATEGORY INTERACTION 
# print("ENCOUNTER ~ CATEGORY * BLOCK + (1|PID)")
# mm.CBrP <- glmer(ENCOUNTER ~ STIMULUS_CATEGORY * BLOCK + (1|PID), 
#                 data = df,family = "binomial",
#                control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
#                optCtrl=list(maxfun=2e5)))
# # :: TEST fixed factor 
# compare_performance(mm.BrP, mm.CrP, mm.C_BrP, mm.CBrP, rank = TRUE)
# ##anova instead of LRT b/c models are not nested 
# anova(mm.C_BrP, mm.CBrP)
# test_lrt(mm.C_BrP, mm.CBrP, verbose = TRUE) #same as anova(m0, m1, test = "Chi")
# paste("A model with an interaction of BLOCK * CATEGORY is a significantly better fit than a model with main effects only. (NOTE that block*category == stimulus. Here we fit the interaction so that we can portion variance between block and category, and compare the models as they will be nested)")
# car::Anova(mm.CBrP, type = 3)
# print("In this model, only the interaction is significant. Neither main effects are significant.")
# print("THIS SUGGESTS THAT ENCOUNTER IS BETTER PREDICTED BY THE UNIQUE STIMULUS THAN THE CATEGORY")
# 
# 
# 
# ## SANITY CHECK, MODEL WITH STIMULUS SHOULD MATCH VARIANCE EXPLAINED BY BLOCK*CATEGORY
# # SUBJECT INTERCEPT | FIXED STIMULUS 
# print("SANITY CHECK — MODEL BY STIMULUS")
# print("ENCOUNTER ~ STIMULUS + (1|PID)")
# mm.SrP <- glmer(ENCOUNTER ~ STIMULUS + (1|PID),
#                 data = df,family = "binomial",
#                control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
#                             optCtrl=list(maxfun=2e5)))
# ## :: TEST fixed factor 
# compare_performance(mm.CBrP, mm.SrP, rank = TRUE)
# anova(mm.SrP, mm.CBrP)
# print ("SANITY CHECKED! STIMULUS MODEL SAME FIT AS BLOCK*CATEGORY")
# 
# 
# #### SET BEST MODEL
# m_best <- mm.CBrP

3.0.2.4 model describe

# ############ DESCRIBE FINAL MODEL ###########
# summary(m_best)
# report(m_best)
# 
# 
# ######### PRINT COEFFICIENTS 
# print("COEFFICIENT ESTIMATES — LOG ODDS")
# tidy(m_best)
# print("COEFFICIENT ESTIMATES — ODDS RATIOS")
# tidy(m_best, exponentiate=TRUE)

3.0.2.5 model vis

# ############ VISUALIZE MODEL COEFFICIENTS 
# #SJPLOT | MODEL | ODDS RATIO
# #library(sjPlot)
# plot_model(m_best, type = "est",
#            vline.color = "red", 
#            show.intercept = TRUE, 
#            show.values = TRUE) + theme_minimal() + 
#   labs(title = "Model Predicted Odds Ratio for ENCOUNTER",
#        subtitle = "")
# 
# 
# 
# ############ VISUALIZE MODEL PREDICTIONS
# #SJPLOT | MODEL | PROBABILITIES
# plot_model(m_best, type = "int", mdrt.values = "meansd") + theme_minimal()
# 
# plot_model(m_best, type="emm", 
#            terms = c("BLOCK"), ci.lvl = 0.95) + theme_minimal() + 
#   labs(title = "Estimated Marginal Means for BLOCK")
# 
# plot_model(m_best, type="emm", 
#            terms = c("STIMULUS_CATEGORY"), ci.lvl = 0.95) + theme_minimal() + 
#   labs(title = "Estimated Marginal Means for CATEGORY")
# 
# plot_model(m_best, type="emm", 
#            terms = c("BLOCK","STIMULUS_CATEGORY"), ci.lvl = 0.95) + theme_minimal() + 
#   labs(title = "Estimated Marginal Means for INTERACTION")
# 
# 
# 
# ## MANUAL PREDICTION INTERACTION PLOT [bc stupid sjPlot cant facet argh]
# means <- estimate_means(m_best, at=c("BLOCK","STIMULUS_CATEGORY"), transform = "response",
#                         backend="emmeans")
# m <- as_tibble(means)
# 
# ## CUSTOM PREDICTIONS PLOT
# m %>% ggplot( aes(x = BLOCK, y = Probability, color=STIMULUS_CATEGORY)) +
#   geom_point() +
#   geom_linerange(aes(ymin = CI_low, ymax=CI_high)) + 
#   scale_y_continuous(limits = c(0,1))+
#   facet_wrap(~STIMULUS_CATEGORY) + 
#   theme_minimal() + easy_remove_legend() + 
#   labs(title = "MODEL PREDICTED Probability of ENGAGE (rather than scroll)")

3.0.3 ENCOUNTER ~ LIKE

Here we explore whether another variable CHART_LIKE is a better predictor of ENCOUNTER than STIMULUS_CATEGORY.

3.0.3.1 visualize

df <- df_graphs %>%
  ## FILTER OUT B0-0 COMMON STIMULUS (so cells can be balanced)
  filter(STIMULUS != "B0-0") %>% 
  select(STIMULUS, STIMULUS_CATEGORY, BLOCK, ENCOUNTER, CHART_LIKE, CHART_TRUST, PID) %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), #REVERSE FACTOR ORDER SO A IS REFERENCE
    ENCOUNTER = fct_rev(ENCOUNTER), #REVERSE SO SCROLL IS REFERENCE
    STIM_NUM = str_remove(STIMULUS, regex("B..", dotall = TRUE))
    ## (only used if not filtering out B0-0)
    ## RECODE #recode b00 graph as category D [bc it fits in that category]
    # STIMULUS_CATEGORY = fct_recode(STIMULUS_CATEGORY, D="F") 
  ) %>% droplevels()


## ENCOUNTER BY AVG CHART LIKE
ggbetweenstats(data = df, x = ENCOUNTER, y=CHART_LIKE, color = ENCOUNTER,
               violin.args = list(width = 0, linewidth = 0), #REMOVE violin plot
               results.subtitle = FALSE) + 
  scale_color_manual(values = my_palettes(name="encounter", direction = "-1")) + 
  labs(title = "ENCOUNTER ~ CHART LIKE")
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.

## ENCOUNTER BY AVG CHART LIKE & CATEGORY
grouped_ggbetweenstats(data = df, x = ENCOUNTER, y=CHART_LIKE, color = ENCOUNTER,
                       grouping.var = STIMULUS_CATEGORY,
               violin.args = list(width = 0, linewidth = 0), #REMOVE violin plot
               results.subtitle = FALSE,
               ggplot.component = scale_color_manual(values = my_palettes(name="encounter", direction = "-1"))
               ) + 
  scale_color_manual(values = my_palettes(name="encounter", direction = "-1")) +
  plot_annotation(title = "ENCOUNTER ~ CHART LIKE + CATEGORY")
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.

## ENCOUNTER BY AVG CHART LIKE & BLOCK
grouped_ggbetweenstats(data = df, x = ENCOUNTER, y=CHART_LIKE, color = ENCOUNTER,
                       grouping.var = BLOCK,
               violin.args = list(width = 0, linewidth = 0), #REMOVE violin plot
               results.subtitle = FALSE,
               ggplot.component = scale_color_manual(values = my_palettes(name="encounter", direction = "-1"))
               ) + 
  scale_color_manual(values = my_palettes(name="encounter", direction = "-1")) +
  plot_annotation(title = "ENCOUNTER ~ CHART LIKE + BLOCK")
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.

## ENCOUNTER BY AVG CHART LIKE & STIMULUS
df %>% 
  group_by(BLOCK, STIMULUS_CATEGORY) %>% mutate(m=mean(CHART_LIKE)) %>%
  ggplot( aes(x = BLOCK, y = CHART_LIKE, color = ENCOUNTER)) + 
  geom_boxplot(width = 0.3, fill = "white", position = position_dodge(width=1)) + 
  geom_jitter(alpha = 0.2, position = position_dodge(width=1)) +
  scale_fill_manual(values = my_palettes(name="encounter", direction = "-1")) +
  scale_color_manual(values = my_palettes(name="encounter", direction = "-1")) +
  facet_wrap(~STIMULUS_CATEGORY) + 
  theme_minimal() + easy_remove_legend() + 
  labs(title = "ENCOUNTER by CHART LIKE for BLOCK & STIMULUS")

3.0.3.2 model fit

Is CHART_LIKE a better predictor of engagement? Here we fit a series of mixed effects logistic regression models, predicting ENCOUNTER (reference category = SCROLL) by CHART_LIKE and comparing this to the best fit model of STIMULUS_CATEGORY and BLOCK to determine if variance in encounter choice is better explained by the stimulus category (i.e. level of embellishment) or whether the participant likes the chart.

df <- df_graphs %>%
  ## FILTER OUT B0-0 COMMON STIMULUS (so cells can be balanced)
  filter(STIMULUS != "B0-0") %>% 
  select(STIMULUS, STIMULUS_CATEGORY, BLOCK, ENCOUNTER, CHART_LIKE, CHART_TRUST, PID) %>% 
  mutate(
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), #REVERSE FACTOR ORDER SO A IS REFERENCE
    ENCOUNTER = fct_rev(ENCOUNTER), #REVERSE SO SCROLL IS REFERENCE
    CHART_LIKE_Z = datawizard::standardise(CHART_LIKE) ## to avoid model non converge
    ## (only used if not filtering out B0-0)
    ## RECODE #recode b00 graph as category D [bc it fits in that category]
    # STIMULUS_CATEGORY = fct_recode(STIMULUS_CATEGORY, D="F") 
  ) %>% droplevels()



################## BUILD MODELS #################

## BEST FIT MODEL OF CATEGORY * BLOCK
# SUBJECT INTERCEPT | FIXED BLOCK * CATEGORY INTERACTION 
print("ENCOUNTER ~ CATEGORY * BLOCK + (1|PID)")
## [1] "ENCOUNTER ~ CATEGORY * BLOCK + (1|PID)"
mm.CBrP <- glmer(ENCOUNTER ~ STIMULUS_CATEGORY * BLOCK + (1|PID), 
                data = df,family = "binomial",
               control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
               optCtrl=list(maxfun=2e5)))



# SUBJECT INTERCEPT | FIXED CHART_LIKE
print("ENCOUNTER ~ CATEGORY + (1|PID)")
## [1] "ENCOUNTER ~ CATEGORY + (1|PID)"
mm.LrP <- glmer(ENCOUNTER ~ CHART_LIKE_Z + (1|PID), 
                data = df,family = "binomial")
# :: TEST fixed factor 
compare_performance(mm.CBrP, mm.LrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma
## # Comparison of Model Performance Indices
## 
## Name    |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical | AIC weights | AICc weights | BIC weights | Performance-Score
## ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.CBrP | glmerMod |      0.157 |      0.127 | 0.035 | 0.459 | 1.000 |    0.609 |      -Inf |           0.002 |    5.06e-39 |     3.03e-39 |    1.29e-63 |             -Inf%
## mm.LrP  | glmerMod |      0.289 |      0.247 | 0.056 | 0.429 | 1.000 |    0.547 |      -Inf |           0.001 |        1.00 |         1.00 |        1.00 |             -Inf%
##anova instead of LRT b/c models are not nested 
anova(mm.CBrP, mm.LrP) #same as anova(m0, m1, test = "Chi")
## Data: df
## Models:
## mm.LrP: ENCOUNTER ~ CHART_LIKE_Z + (1 | PID)
## mm.CBrP: ENCOUNTER ~ STIMULUS_CATEGORY * BLOCK + (1 | PID)
##         npar    AIC    BIC  logLik deviance Chisq Df Pr(>Chisq)
## mm.LrP     3 1484.6 1500.0 -739.28   1478.6                    
## mm.CBrP   25 1660.9 1789.6 -805.46   1610.9     0 22          1
paste("A model with CHART_LIKE predicting ENCOUNTER is a better fit than a model with CATEGORY*BLOCK, though not significantly so")
## [1] "A model with CHART_LIKE predicting ENCOUNTER is a better fit than a model with CATEGORY*BLOCK, though not significantly so"
car::Anova(mm.LrP, type = 3)
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: ENCOUNTER
##                Chisq Df            Pr(>Chisq)    
## (Intercept)   26.194  1          0.0000003088 ***
## CHART_LIKE_Z 170.852  1 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print("CHART_LIKE is a significant predictor in this model")
## [1] "CHART_LIKE is a significant predictor in this model"
# SUBJECT INTERCEPT | FIXED CHART_LIKE + STIMULUS_CATEGORY * BLOCK
print("ENCOUNTER ~ CATEGORY * BLOCK + (1|PID)")
## [1] "ENCOUNTER ~ CATEGORY * BLOCK + (1|PID)"
mm.L_CBrP <- glmer(ENCOUNTER ~ CHART_LIKE_Z + STIMULUS_CATEGORY * BLOCK + (1|PID), 
                data = df,family = "binomial",
               control=glmerControl(optimizer="bobyqa", #would not converge under Nelder)Mead
               optCtrl=list(maxfun=2e5)))
# :: TEST fixed factor 
compare_performance(mm.LrP, mm.CBrP, mm.L_CBrP, rank = TRUE)
## Following indices with missing values are not used for ranking: Sigma
## # Comparison of Model Performance Indices
## 
## Name      |    Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma | Log_loss | Score_log | Score_spherical | AIC weights | AICc weights | BIC weights | Performance-Score
## ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
## mm.LrP    | glmerMod |      0.289 |      0.247 | 0.056 | 0.429 | 1.000 |    0.547 |      -Inf |           0.001 |    4.56e-09 |     7.93e-09 |        1.00 |             -Inf%
## mm.CBrP   | glmerMod |      0.157 |      0.127 | 0.035 | 0.459 | 1.000 |    0.609 |      -Inf |           0.002 |    2.31e-47 |     2.41e-47 |    1.29e-63 |             -Inf%
## mm.L_CBrP | glmerMod |      0.391 |      0.332 | 0.088 | 0.406 | 1.000 |    0.500 |      -Inf |           0.001 |       1.000 |        1.000 |    4.25e-18 |             -Inf%
##anova instead of LRT b/c models are not nested 

### CHECK AGAINST JUST CHART LIKE
anova(mm.L_CBrP, mm.LrP)
## Data: df
## Models:
## mm.LrP: ENCOUNTER ~ CHART_LIKE_Z + (1 | PID)
## mm.L_CBrP: ENCOUNTER ~ CHART_LIKE_Z + STIMULUS_CATEGORY * BLOCK + (1 | PID)
##           npar    AIC  BIC  logLik deviance  Chisq Df     Pr(>Chisq)    
## mm.LrP       3 1484.6 1500 -739.28   1478.6                             
## mm.L_CBrP   26 1446.2 1580 -697.08   1394.2 84.414 23 0.000000006037 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
test_lrt(mm.L_CBrP, mm.LrP, verbose = TRUE) #same as anova(m0, m1, test = "Chi")
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name      |    Model | df | df_diff |  Chi2 |      p
## ----------------------------------------------------
## mm.L_CBrP | glmerMod | 26 |         |       |       
## mm.LrP    | glmerMod |  3 |     -23 | 84.41 | < .001
paste("A model adding the interaction of BLOCK * CATEGORY to CHART_LIKE is a significantly better fit than a model with the CHART_LIKE alone")
## [1] "A model adding the interaction of BLOCK * CATEGORY to CHART_LIKE is a significantly better fit than a model with the CHART_LIKE alone"
### CHECK AGAINST IXN MODEL
anova(mm.L_CBrP, mm.CBrP)
## Data: df
## Models:
## mm.CBrP: ENCOUNTER ~ STIMULUS_CATEGORY * BLOCK + (1 | PID)
## mm.L_CBrP: ENCOUNTER ~ CHART_LIKE_Z + STIMULUS_CATEGORY * BLOCK + (1 | PID)
##           npar    AIC    BIC  logLik deviance  Chisq Df            Pr(>Chisq)
## mm.CBrP     25 1660.9 1789.6 -805.46   1610.9                                
## mm.L_CBrP   26 1446.2 1580.0 -697.08   1394.2 216.77  1 < 0.00000000000000022
##              
## mm.CBrP      
## mm.L_CBrP ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
test_lrt(mm.L_CBrP, mm.CBrP, verbose = TRUE) #same as anova(m0, m1, test = "Chi")
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name      |    Model | df | df_diff |   Chi2 |      p
## -----------------------------------------------------
## mm.L_CBrP | glmerMod | 26 |         |        |       
## mm.CBrP   | glmerMod | 25 |      -1 | 216.77 | < .001
paste("A model adding CHART LIKE to the interaction of BLOCK * CATEGORY is a significantly better fit than a model with the interaction only.")
## [1] "A model adding CHART LIKE to the interaction of BLOCK * CATEGORY is a significantly better fit than a model with the interaction only."
### EXAMINE THIS MODEL
car::Anova(mm.L_CBrP, type = 3)
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: ENCOUNTER
##                            Chisq Df            Pr(>Chisq)    
## (Intercept)               1.4215  1             0.2331547    
## CHART_LIKE_Z            145.9067  1 < 0.00000000000000022 ***
## STIMULUS_CATEGORY        11.2661  3             0.0103705 *  
## BLOCK                     5.2701  5             0.3838125    
## STIMULUS_CATEGORY:BLOCK  39.6133 15             0.0005186 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print("In this model, the CHART_LIKE variable is significant, along with the STIMULUS_CATEGORY and interaction of CATEGORY & BLOCK")
## [1] "In this model, the CHART_LIKE variable is significant, along with the STIMULUS_CATEGORY and interaction of CATEGORY & BLOCK"
print("THIS SUGGESTS THAT ENCOUNTER IS BETTER PREDICTED BY THE UNIQUE STIMULUS THAN THE CATEGORY")
## [1] "THIS SUGGESTS THAT ENCOUNTER IS BETTER PREDICTED BY THE UNIQUE STIMULUS THAN THE CATEGORY"
#### SET BEST MODEL
m_best <- mm.L_CBrP

3.0.3.3 model describe

############ DESCRIBE FINAL MODEL ###########
summary(m_best)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: ENCOUNTER ~ CHART_LIKE_Z + STIMULUS_CATEGORY * BLOCK + (1 | PID)
##    Data: df
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 200000))
## 
##      AIC      BIC   logLik deviance df.resid 
##   1446.2   1580.0   -697.1   1394.2     1246 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5050 -0.6361 -0.3146  0.6858  4.3465 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  PID    (Intercept) 0.3155   0.5617  
## Number of obs: 1272, groups:  PID, 318
## 
## Fixed effects:
##                            Estimate Std. Error z value             Pr(>|z|)    
## (Intercept)                 0.38545    0.32329   1.192             0.233155    
## CHART_LIKE_Z               -1.11596    0.09239 -12.079 < 0.0000000000000002 ***
## STIMULUS_CATEGORYB         -1.10181    0.44869  -2.456             0.014064 *  
## STIMULUS_CATEGORYC         -1.25056    0.45379  -2.756             0.005855 ** 
## STIMULUS_CATEGORYD         -1.32552    0.44887  -2.953             0.003147 ** 
## BLOCKB2                    -0.41194    0.45923  -0.897             0.369712    
## BLOCKB3                    -0.30969    0.45895  -0.675             0.499815    
## BLOCKB4                     0.10779    0.45789   0.235             0.813898    
## BLOCKB5                    -0.20397    0.46337  -0.440             0.659810    
## BLOCKB6                    -0.84238    0.46205  -1.823             0.068287 .  
## STIMULUS_CATEGORYB:BLOCKB2  1.71645    0.64920   2.644             0.008194 ** 
## STIMULUS_CATEGORYC:BLOCKB2 -0.37252    0.72522  -0.514             0.607484    
## STIMULUS_CATEGORYD:BLOCKB2  0.43672    0.64963   0.672             0.501417    
## STIMULUS_CATEGORYB:BLOCKB3  0.51062    0.63962   0.798             0.424691    
## STIMULUS_CATEGORYC:BLOCKB3  0.29387    0.62890   0.467             0.640301    
## STIMULUS_CATEGORYD:BLOCKB3  0.94209    0.64855   1.453             0.146337    
## STIMULUS_CATEGORYB:BLOCKB4  0.52054    0.63334   0.822             0.411135    
## STIMULUS_CATEGORYC:BLOCKB4  0.39450    0.64248   0.614             0.539198    
## STIMULUS_CATEGORYD:BLOCKB4  0.40516    0.63476   0.638             0.523287    
## STIMULUS_CATEGORYB:BLOCKB5  0.41306    0.63616   0.649             0.516146    
## STIMULUS_CATEGORYC:BLOCKB5  1.15897    0.64591   1.794             0.072763 .  
## STIMULUS_CATEGORYD:BLOCKB5 -0.04324    0.66129  -0.065             0.947865    
## STIMULUS_CATEGORYB:BLOCKB6  2.42129    0.64516   3.753             0.000175 ***
## STIMULUS_CATEGORYC:BLOCKB6  0.40992    0.66792   0.614             0.539395    
## STIMULUS_CATEGORYD:BLOCKB6  0.65873    0.64198   1.026             0.304853    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation matrix not shown by default, as p = 25 > 12.
## Use print(x, correlation=TRUE)  or
##     vcov(x)        if you need it
report(m_best)
## We fitted a logistic mixed model (estimated using ML and BOBYQA optimizer) to
## predict ENCOUNTER with CHART_LIKE_Z, STIMULUS_CATEGORY and BLOCK (formula:
## ENCOUNTER ~ CHART_LIKE_Z + STIMULUS_CATEGORY * BLOCK). The model included PID
## as random effect (formula: ~1 | PID). The model's total explanatory power is
## substantial (conditional R2 = 0.39) and the part related to the fixed effects
## alone (marginal R2) is of 0.33. The model's intercept, corresponding to
## CHART_LIKE_Z = 0, STIMULUS_CATEGORY = A and BLOCK = B1, is at 0.39 (95% CI
## [-0.25, 1.02], p = 0.233). Within this model:
## 
##   - The effect of CHART LIKE Z is statistically significant and negative (beta =
## -1.12, 95% CI [-1.30, -0.93], p < .001; Std. beta = -1.12, 95% CI [-1.30,
## -0.93])
##   - The effect of STIMULUS CATEGORY [B] is statistically significant and negative
## (beta = -1.10, 95% CI [-1.98, -0.22], p = 0.014; Std. beta = -1.10, 95% CI
## [-1.98, -0.22])
##   - The effect of STIMULUS CATEGORY [C] is statistically significant and negative
## (beta = -1.25, 95% CI [-2.14, -0.36], p = 0.006; Std. beta = -1.25, 95% CI
## [-2.14, -0.36])
##   - The effect of STIMULUS CATEGORY [D] is statistically significant and negative
## (beta = -1.33, 95% CI [-2.21, -0.45], p = 0.003; Std. beta = -1.33, 95% CI
## [-2.21, -0.45])
##   - The effect of BLOCK [B2] is statistically non-significant and negative (beta
## = -0.41, 95% CI [-1.31, 0.49], p = 0.370; Std. beta = -0.41, 95% CI [-1.31,
## 0.49])
##   - The effect of BLOCK [B3] is statistically non-significant and negative (beta
## = -0.31, 95% CI [-1.21, 0.59], p = 0.500; Std. beta = -0.31, 95% CI [-1.21,
## 0.59])
##   - The effect of BLOCK [B4] is statistically non-significant and positive (beta
## = 0.11, 95% CI [-0.79, 1.01], p = 0.814; Std. beta = 0.11, 95% CI [-0.79,
## 1.01])
##   - The effect of BLOCK [B5] is statistically non-significant and negative (beta
## = -0.20, 95% CI [-1.11, 0.70], p = 0.660; Std. beta = -0.20, 95% CI [-1.11,
## 0.70])
##   - The effect of BLOCK [B6] is statistically non-significant and negative (beta
## = -0.84, 95% CI [-1.75, 0.06], p = 0.068; Std. beta = -0.84, 95% CI [-1.75,
## 0.06])
##   - The effect of STIMULUS CATEGORY [B] × BLOCK [B2] is statistically significant
## and positive (beta = 1.72, 95% CI [0.44, 2.99], p = 0.008; Std. beta = 1.72,
## 95% CI [0.44, 2.99])
##   - The effect of STIMULUS CATEGORY [C] × BLOCK [B2] is statistically
## non-significant and negative (beta = -0.37, 95% CI [-1.79, 1.05], p = 0.607;
## Std. beta = -0.37, 95% CI [-1.79, 1.05])
##   - The effect of STIMULUS CATEGORY [D] × BLOCK [B2] is statistically
## non-significant and positive (beta = 0.44, 95% CI [-0.84, 1.71], p = 0.501;
## Std. beta = 0.44, 95% CI [-0.84, 1.71])
##   - The effect of STIMULUS CATEGORY [B] × BLOCK [B3] is statistically
## non-significant and positive (beta = 0.51, 95% CI [-0.74, 1.76], p = 0.425;
## Std. beta = 0.51, 95% CI [-0.74, 1.76])
##   - The effect of STIMULUS CATEGORY [C] × BLOCK [B3] is statistically
## non-significant and positive (beta = 0.29, 95% CI [-0.94, 1.53], p = 0.640;
## Std. beta = 0.29, 95% CI [-0.94, 1.53])
##   - The effect of STIMULUS CATEGORY [D] × BLOCK [B3] is statistically
## non-significant and positive (beta = 0.94, 95% CI [-0.33, 2.21], p = 0.146;
## Std. beta = 0.94, 95% CI [-0.33, 2.21])
##   - The effect of STIMULUS CATEGORY [B] × BLOCK [B4] is statistically
## non-significant and positive (beta = 0.52, 95% CI [-0.72, 1.76], p = 0.411;
## Std. beta = 0.52, 95% CI [-0.72, 1.76])
##   - The effect of STIMULUS CATEGORY [C] × BLOCK [B4] is statistically
## non-significant and positive (beta = 0.39, 95% CI [-0.86, 1.65], p = 0.539;
## Std. beta = 0.39, 95% CI [-0.86, 1.65])
##   - The effect of STIMULUS CATEGORY [D] × BLOCK [B4] is statistically
## non-significant and positive (beta = 0.41, 95% CI [-0.84, 1.65], p = 0.523;
## Std. beta = 0.41, 95% CI [-0.84, 1.65])
##   - The effect of STIMULUS CATEGORY [B] × BLOCK [B5] is statistically
## non-significant and positive (beta = 0.41, 95% CI [-0.83, 1.66], p = 0.516;
## Std. beta = 0.41, 95% CI [-0.83, 1.66])
##   - The effect of STIMULUS CATEGORY [C] × BLOCK [B5] is statistically
## non-significant and positive (beta = 1.16, 95% CI [-0.11, 2.42], p = 0.073;
## Std. beta = 1.16, 95% CI [-0.11, 2.43])
##   - The effect of STIMULUS CATEGORY [D] × BLOCK [B5] is statistically
## non-significant and negative (beta = -0.04, 95% CI [-1.34, 1.25], p = 0.948;
## Std. beta = -0.04, 95% CI [-1.34, 1.25])
##   - The effect of STIMULUS CATEGORY [B] × BLOCK [B6] is statistically significant
## and positive (beta = 2.42, 95% CI [1.16, 3.69], p < .001; Std. beta = 2.42, 95%
## CI [1.16, 3.69])
##   - The effect of STIMULUS CATEGORY [C] × BLOCK [B6] is statistically
## non-significant and positive (beta = 0.41, 95% CI [-0.90, 1.72], p = 0.539;
## Std. beta = 0.41, 95% CI [-0.90, 1.72])
##   - The effect of STIMULUS CATEGORY [D] × BLOCK [B6] is statistically
## non-significant and positive (beta = 0.66, 95% CI [-0.60, 1.92], p = 0.305;
## Std. beta = 0.66, 95% CI [-0.60, 1.92])
## 
## Standardized parameters were obtained by fitting the model on a standardized
## version of the dataset. 95% Confidence Intervals (CIs) and p-values were
## computed using a Wald z-distribution approximation.
######### PRINT COEFFICIENTS 
# print("COEFFICIENT ESTIMATES — LOG ODDS")
# tidy(m_best)
print("COEFFICIENT ESTIMATES — ODDS RATIOS")
## [1] "COEFFICIENT ESTIMATES — ODDS RATIOS"
tidy(m_best, exponentiate=TRUE)
## # A tibble: 26 × 7
##    effect group term               estimate std.error statistic  p.value
##    <chr>  <chr> <chr>                 <dbl>     <dbl>     <dbl>    <dbl>
##  1 fixed  <NA>  (Intercept)           1.47     0.475      1.19  2.33e- 1
##  2 fixed  <NA>  CHART_LIKE_Z          0.328    0.0303   -12.1   1.36e-33
##  3 fixed  <NA>  STIMULUS_CATEGORYB    0.332    0.149     -2.46  1.41e- 2
##  4 fixed  <NA>  STIMULUS_CATEGORYC    0.286    0.130     -2.76  5.85e- 3
##  5 fixed  <NA>  STIMULUS_CATEGORYD    0.266    0.119     -2.95  3.15e- 3
##  6 fixed  <NA>  BLOCKB2               0.662    0.304     -0.897 3.70e- 1
##  7 fixed  <NA>  BLOCKB3               0.734    0.337     -0.675 5.00e- 1
##  8 fixed  <NA>  BLOCKB4               1.11     0.510      0.235 8.14e- 1
##  9 fixed  <NA>  BLOCKB5               0.815    0.378     -0.440 6.60e- 1
## 10 fixed  <NA>  BLOCKB6               0.431    0.199     -1.82  6.83e- 2
## # ℹ 16 more rows

3.0.3.4 model vis

############ VISUALIZE MODEL COEFFICIENTS 
#SJPLOT | MODEL | ODDS RATIO
#library(sjPlot)
plot_model(m_best, type = "est",
           vline.color = "red", 
           show.intercept = TRUE, 
           show.values = TRUE) + theme_minimal() + 
  labs(title = "Model Predicted Odds Ratio for ENCOUNTER",
       subtitle = "")

############ VISUALIZE MODEL PREDICTIONS
#SJPLOT | MODEL | PROBABILITIES

plot_model(m_best, type="pred", 
           terms = c("CHART_LIKE_Z"), ci.lvl = 0.95) + theme_minimal() + 
  labs(title = "Estimated Marginal Means on ENCOUNTER",
       subtitle = "Probability of ENAGAGE steadily increases as a function of CHART_LIKE",
       caption = "predicted effect of CHART LIKE holding CATEGORY and BLOCK at weighted average")
## Data were 'prettified'. Consider using `terms="CHART_LIKE_Z [all]"` to
##   get smooth plots.

plot_model(m_best, type="pred", 
           terms = c("CHART_LIKE_Z", "STIMULUS_CATEGORY"), ci.lvl = 0.95) + theme_minimal() + 
  labs(title = "Estimated Marginal Means on ENCOUNTER",
       subtitle = "Increases as a function of CHART_LIKE, with CATEGORY A (least embellished) lower",
       caption = "predicted effect of CHART LIKE AT CATEGORY holding BLOCK at weighted average")
## Data were 'prettified'. Consider using `terms="CHART_LIKE_Z [all]"` to
##   get smooth plots.

plot_model(m_best, type="pred", 
           terms = c("CHART_LIKE_Z", "BLOCK"), ci.lvl = 0.95) + theme_minimal() + 
      labs(title = "Estimated Marginal Means on ENCOUNTER",
           subtitle = "Steady increases by CHART_LIKE, little diff by block",
          caption = "predicted effect of CHART LIKE AT BLOCK holding CATEGORY at weighted average")
## Data were 'prettified'. Consider using `terms="CHART_LIKE_Z [all]"` to
##   get smooth plots.

plot_model(m_best, type="pred", 
           terms = c("CHART_LIKE_Z","STIMULUS_CATEGORY","BLOCK"), ci.lvl = 0.95) + theme_minimal() + 
  labs(title = "Estimated Marginal Means on ENCOUNTER",
       subtitle = "Steady increase by CHART_LIKE, with CATEGORY differences differing by BLOCK",
       caption = "predicted effect conditioned on all predictors")
## Data were 'prettified'. Consider using `terms="CHART_LIKE_Z [all]"` to
##   get smooth plots.

## MANUAL PREDICTION INTERACTION PLOT [bc sjPlot cant facet argh]
means <- estimate_means(m_best, at=c("CHART_LIKE_Z","BLOCK","STIMULUS_CATEGORY"), transform = "response",
                        backend="emmeans")
m <- as_tibble(means)

## CUSTOM PREDICTIONS PLOT
m %>% ggplot( aes(x = CHART_LIKE_Z, y = Probability, color=STIMULUS_CATEGORY, fill=STIMULUS_CATEGORY)) +
  geom_ribbon(aes(x=CHART_LIKE_Z, ymin = CI_low, ymax=CI_high), alpha= 0.5) + 
  geom_linerange(aes(ymin = CI_low, ymax=CI_high)) +
  geom_point() +
  scale_y_continuous(limits = c(0,1))+
  facet_grid(BLOCK ~ STIMULUS_CATEGORY) +
  # facet_wrap(~BLOCK) +
  theme_minimal() + easy_remove_legend() + 
  labs(title = "MODEL PREDICTED Probability of ENGAGE (rather than scroll)",
      subtitle = "Steady increase by CHART_LIKE, with CATEGORY differences differing by BLOCK",
       caption = "ENCONTER ~ CHART_LIKE_Z + CATEGORY * BLOCK + (1|PID")

3.0.4 WIP DATA AND DESIGN BY CATEGORY and BLOCK

3.0.4.1 visualization

df <- df_graphs %>% 
  mutate(
    ## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
    ## we want the reverse 
    ## chose NOT to z-score data, bc we want the data in terms of the original scale 
    r_MAKER_DATA = reverse_scale(MAKER_DATA),
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
  ) %>% filter(STIMULUS!="B0-0") %>% 
  group_by(STIMULUS_CATEGORY, BLOCK) %>% 
  mutate(
    m=mean(MAKER_DATA), 
    md=median(MAKER_DATA)
  )

df %>% ggplot(aes(x=MAKER_DATA,  y=BLOCK))+
  geom_density_ridges( scale = 0.75) + 
  # ##MEDIAN
  # stat_summary(fun=median, geom="text", colour="red",  fontface = "bold", size = 2.5,
  #              vjust=+2, hjust = 0, aes( label=round(md, digits=0)))+
  # stat_summary(fun=median, geom="point", shape=20, size=3, color="red", fill="red") +
  ## MEAN
  stat_summary(fun=mean, geom="text", colour="blue",  fontface = "bold", size = 2.5,
               vjust=+2, hjust = 0, aes( label=round(m, digits=0)))+
  stat_summary(fun="mean", geom="point", shape=20, size=3, color="blue", fill="blue") +
  facet_wrap(~STIMULUS_CATEGORY)+ 
  labs(title = "MAKER_DATA by BLOCK AND CATEGORY", caption="(mean in blue)")+
  theme_minimal() + easy_remove_legend()
## Picking joint bandwidth of 8.98
## Picking joint bandwidth of 9.15
## Picking joint bandwidth of 9.02
## Picking joint bandwidth of 9.8

3.0.4.2 models

3.0.4.2.1 MAKER_DATA BY CATEGORY
### LINEAR MIXED EFFECTS MODEL ##################

df <- df_graphs %>% 
  mutate(
    ## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
    ## we want the reverse 
    ## chose NOT to z-score data, bc we want the data in terms of the original scale 
    r_MAKER_DATA = reverse_scale(MAKER_DATA),
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
  ) %>% filter(STIMULUS!="B0-0")

## SET CONTRASTS
# contrasts(df$MAKER_ID) <-car::contr.Treatment(levels(df$MAKER_ID)) # intercept first group mean; coeff dif from first

## DEFINE MODEL
mr1 <-lmer(r_MAKER_DATA ~  (1|PID) , data=df)
mr2 <-lmer(r_MAKER_DATA ~  (1|PID) + (1|STIMULUS), data=df)
mm1 <-lmer(r_MAKER_DATA ~  STIMULUS +  (1|PID) , data=df)
mm2 <-lmer(r_MAKER_DATA ~  STIMULUS_CATEGORY +  (1|PID) , data=df)
mm3 <-lmer(r_MAKER_DATA ~  BLOCK +  (1|PID) , data=df)
mm4 <-lmer(r_MAKER_DATA ~  STIMULUS_CATEGORY*BLOCK +  (1|PID) , data=df)



## sig diff between categories?
print("PREDICTED BY CATEGORY?")
## [1] "PREDICTED BY CATEGORY?"
print("we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial")
## [1] "we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial"
f <- "MAKER_DATA ~ STIMULUS_CATEGORY"
anova(mm2)
## Type III Analysis of Variance Table with Satterthwaite's method
##                   Sum Sq Mean Sq NumDF DenDF F value                Pr(>F)    
## STIMULUS_CATEGORY  57625   19208     3   951  30.447 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm2)
means <- estimate_means(mm2, at="STIMULUS_CATEGORY")
contrasts <- estimate_contrasts(mm2, contrast="STIMULUS_CATEGORY",method="pairwise")
plot(contrasts, means) + 
    geom_text(aes(x=means$STIMULUS_CATEGORY, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

print("PREDICTED BY BLOCK")
## [1] "PREDICTED BY BLOCK"
print("we do not expect to see sig diffs btwn blocks if they are aesthetically balanced")
## [1] "we do not expect to see sig diffs btwn blocks if they are aesthetically balanced"
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
anova(mm3)
## Type III Analysis of Variance Table with Satterthwaite's method
##       Sum Sq Mean Sq NumDF DenDF F value      Pr(>F)    
## BLOCK  25396  5079.2     5   312  7.3686 0.000001511 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm3)
means <- estimate_means(mm3, at="BLOCK")
contrasts <- estimate_contrasts(mm3, contrast="BLOCK",method="pairwise")
plot(contrasts, means) + 
    geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

print("PREDICTED BY INTERACTION")
## [1] "PREDICTED BY INTERACTION"
print("")
## [1] ""
f <- "MAKER_DATA ~ STIMULUS_CATEGORY"
anova(mm4)
## Type III Analysis of Variance Table with Satterthwaite's method
##                         Sum Sq Mean Sq NumDF DenDF F value
## STIMULUS_CATEGORY        57577 19192.4     3   936 38.7034
## BLOCK                    18270  3654.0     5   312  7.3686
## STIMULUS_CATEGORY:BLOCK 135818  9054.6    15   936 18.2594
##                                        Pr(>F)    
## STIMULUS_CATEGORY       < 0.00000000000000022 ***
## BLOCK                             0.000001511 ***
## STIMULUS_CATEGORY:BLOCK < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm4)
means <- estimate_means(mm4, at=c("STIMULUS_CATEGORY","BLOCK"))
contrasts <- estimate_contrasts(mm4, c("STIMULUS_CATEGORY","BLOCK"),method="pairwise")
plot(contrasts, means) + facet_wrap("BLOCK")+
    # geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

## TEST MODEL FIT 
# test_performance(mm2,mm3)    
# test_performance(mm2,mm4)    
# test_performance(mm3,mm4)    
anova(mm2,mm3)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm2: r_MAKER_DATA ~ STIMULUS_CATEGORY + (1 | PID)
## mm3: r_MAKER_DATA ~ BLOCK + (1 | PID)
##     npar   AIC   BIC  logLik deviance Chisq Df Pr(>Chisq)
## mm2    6 11942 11973 -5965.1    11930                    
## mm3    8 11998 12040 -5991.1    11982     0  2          1
print("the model with CATEGORY is not a significantly better fit than the model with BLOCK")
## [1] "the model with CATEGORY is not a significantly better fit than the model with BLOCK"
test_likelihoodratio(mm2, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name |           Model | df | df_diff |   Chi2 |      p
## -------------------------------------------------------
## mm2  | lmerModLmerTest |  6 |         |        |       
## mm4  | lmerModLmerTest | 26 |      20 | 280.36 | < .001
print("interaction better fit than category")
## [1] "interaction better fit than category"
test_likelihoodratio(mm3, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name |           Model | df | df_diff |   Chi2 |      p
## -------------------------------------------------------
## mm3  | lmerModLmerTest |  8 |         |        |       
## mm4  | lmerModLmerTest | 26 |      18 | 332.40 | < .001
print("interaction better fit than block")
## [1] "interaction better fit than block"
compare_models(mm2,mm3,mm4)
## Parameter                          |                     mm2 |                   mm3 |                     mm4
## --------------------------------------------------------------------------------------------------------------
## (Intercept)                        |  70.55 ( 67.62,  73.47) | 56.97 ( 53.13, 60.82) |  64.95 ( 58.56,  71.34)
## STIMULUS CATEGORY (B)              |  -7.71 (-11.62,  -3.81) |                       |  -1.13 ( -9.46,   7.20)
## STIMULUS CATEGORY (C)              | -16.10 (-20.01, -12.19) |                       | -17.56 (-25.89,  -9.23)
## STIMULUS CATEGORY (D)              | -16.23 (-20.13, -12.32) |                       | -13.20 (-21.53,  -4.87)
## BLOCK (B2)                         |                         |  5.47 ( -0.05, 10.99) |   7.75 ( -1.42,  16.91)
## BLOCK (B3)                         |                         |  6.62 (  1.10, 12.14) |  10.59 (  1.43,  19.76)
## BLOCK (B4)                         |                         | 10.79 (  5.32, 16.26) |  14.11 (  5.03,  23.19)
## BLOCK (B5)                         |                         | -4.67 (-10.16,  0.82) |   4.66 ( -4.46,  13.78)
## BLOCK (B6)                         |                         |  3.26 ( -2.26,  8.78) |  -3.48 (-12.65,   5.68)
## STIMULUS CATEGORY (B) × BLOCK (B3) |                         |                       | -12.80 (-24.75,  -0.85)
## STIMULUS CATEGORY (B) × BLOCK (B2) |                         |                       | -17.22 (-29.17,  -5.27)
## STIMULUS CATEGORY (C) × BLOCK (B2) |                         |                       |  15.35 (  3.40,  27.30)
## STIMULUS CATEGORY (D) × BLOCK (B2) |                         |                       |  -7.24 (-19.19,   4.71)
## STIMULUS CATEGORY (C) × BLOCK (B4) |                         |                       |  15.93 (  4.10,  27.77)
## STIMULUS CATEGORY (C) × BLOCK (B3) |                         |                       | -10.40 (-22.35,   1.55)
## STIMULUS CATEGORY (D) × BLOCK (B3) |                         |                       |   7.32 ( -4.64,  19.27)
## STIMULUS CATEGORY (B) × BLOCK (B4) |                         |                       | -28.08 (-39.91, -16.24)
## STIMULUS CATEGORY (D) × BLOCK (B5) |                         |                       | -16.29 (-28.18,  -4.40)
## STIMULUS CATEGORY (D) × BLOCK (B4) |                         |                       |  -1.13 (-12.97,  10.70)
## STIMULUS CATEGORY (B) × BLOCK (B5) |                         |                       |   7.01 ( -4.88,  18.91)
## STIMULUS CATEGORY (C) × BLOCK (B5) |                         |                       | -28.04 (-39.93, -16.15)
## STIMULUS CATEGORY (B) × BLOCK (B6) |                         |                       |  11.74 ( -0.21,  23.69)
## STIMULUS CATEGORY (C) × BLOCK (B6) |                         |                       |  16.03 (  4.07,  27.98)
## STIMULUS CATEGORY (D) × BLOCK (B6) |                         |                       |  -0.80 (-12.75,  11.15)
## --------------------------------------------------------------------------------------------------------------
## Observations                       |                    1272 |                  1272 |                    1272
compare_performance(mr1, mr2, mm1,mm2,mm3,mm4, rank=TRUE)
## # Comparison of Model Performance Indices
## 
## Name |           Model | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## mm1  | lmerModLmerTest |      0.348 |      0.232 | 0.150 | 20.885 | 22.268 |       0.500 |        0.500 |    5.59e-15 |            79.12%
## mm4  | lmerModLmerTest |      0.348 |      0.232 | 0.150 | 20.885 | 22.268 |       0.500 |        0.500 |    5.59e-15 |            79.12%
## mr2  | lmerModLmerTest |      0.346 |      0.000 | 0.346 | 20.898 | 22.270 |    2.27e-11 |     3.93e-11 |       1.000 |            62.36%
## mm2  | lmerModLmerTest |      0.160 |      0.060 | 0.106 | 24.046 | 25.117 |    3.20e-53 |     5.45e-53 |    8.19e-45 |            16.89%
## mm3  | lmerModLmerTest |      0.085 |      0.033 | 0.054 | 25.587 | 26.255 |    2.17e-65 |     3.60e-65 |    3.22e-59 |             1.94%
## mr1  | lmerModLmerTest |      0.081 |      0.000 | 0.081 | 25.380 | 26.255 |    6.45e-71 |     1.12e-70 |    3.72e-59 |             1.70%
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"


## PLOT BEST FIT MODEL PREDICTIONS
(p_data <- cat_plot(mm4, pred = BLOCK, modx = STIMULUS_CATEGORY,
         geom = "line", interval.geom= "linerange", 
         interval=TRUE, int.type = "confidence", int.width = 0.95, robust = TRUE,
         plot.points = FALSE) + 
    facet_wrap(~STIMULUS_CATEGORY) + 
    labs(title = "LMER Predictions | MAKER_DATA by BLOCK X CATEGORY", 
         caption = f, 
         y="MAKER_DATA \n 0(layerpson) --> 100 (professional)") + easy_remove_legend()
)

# if(GRAPH_SAVE){
#   ggsave(plot = p_data, path="figs/level_category/models", filename =paste0("lmer_maker_DATA_by_stimulus_category","_ixn.png"), units = c("in"))
# }


## PLOT MODEL PARAMETERS
plot_model(mm4, type = "est",
        # show.intercept = TRUE,
        show.values = TRUE,
        value.offset = .25,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

INTERPRETATION Here we see that a linear mixed effects model, predicting MAKER_DATA by the interaction of STIMULUS_CATEGORY and BLOCK indicates that ratings of maker data competencies do NOT vary consistently as a function of CATEGORY (i.e. the degree of ‘embellishment’). Although the degree of embellishment within a block (A,B,C,D) is the same, the ratings of maker data competency vary. This pattern is particularly salient in categories C and D (with more embellishment). These data suggest that social inferences about a maker’s data competency are not made solely based on the amount of embellishment, but rather, in response to the particular features of the visualization. A highly embellished chart might be rated with relatively high high data competency (e.g. B3-D) or lower data competency (eg. B5-D).

3.0.4.2.2 MAKER_DESIGN BY CATEGORY
df <- df_graphs %>% 
  mutate(
    ## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
    ## we want the reverse 
    ## chose NOT to z-score data, bc we want the data in terms of the original scale 
    r_MAKER_DESIGN = reverse_scale(MAKER_DESIGN),
    STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
  ) %>% filter(STIMULUS!="B0-0")


## DEFINE MODEL
mr1 <-lmer(r_MAKER_DESIGN ~  (1|PID) , data=df)
mr2 <-lmer(r_MAKER_DESIGN ~  (1|PID) + (1|STIMULUS), data=df)
mm1 <-lmer(r_MAKER_DESIGN ~  STIMULUS +  (1|PID) , data=df)
mm2 <-lmer(r_MAKER_DESIGN ~  STIMULUS_CATEGORY +  (1|PID) , data=df)
mm3 <-lmer(r_MAKER_DESIGN ~  BLOCK +  (1|PID) , data=df)
mm4 <-lmer(r_MAKER_DESIGN ~  STIMULUS_CATEGORY*BLOCK +  (1|PID) , data=df)



## sig diff between categories?
print("PREDICTED BY CATEGORY?")
## [1] "PREDICTED BY CATEGORY?"
print("we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial")
## [1] "we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial"
f <- "MAKER_DESIGN ~ STIMULUS_CATEGORY"
anova(mm2)
## Type III Analysis of Variance Table with Satterthwaite's method
##                   Sum Sq Mean Sq NumDF DenDF F value                Pr(>F)    
## STIMULUS_CATEGORY  87257   29086     3   951  43.882 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm2)
means <- estimate_means(mm2, at="STIMULUS_CATEGORY")
contrasts <- estimate_contrasts(mm2, contrast="STIMULUS_CATEGORY",method="pairwise")
plot(contrasts, means) + 
    geom_text(aes(x=means$STIMULUS_CATEGORY, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

print("PREDICTED BY BLOCK")
## [1] "PREDICTED BY BLOCK"
print("we do not expect to see sig diffs btwn blocks if they are aesthetically balanced")
## [1] "we do not expect to see sig diffs btwn blocks if they are aesthetically balanced"
f <- "MAKER_DESIGN ~ BLOCK"
anova(mm3)
## Type III Analysis of Variance Table with Satterthwaite's method
##       Sum Sq Mean Sq NumDF DenDF F value     Pr(>F)    
## BLOCK  21562  4312.5     5   312  5.7332 0.00004446 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm3)
means <- estimate_means(mm3, at="BLOCK")
contrasts <- estimate_contrasts(mm3, contrast="BLOCK",method="pairwise")
plot(contrasts, means) + 
    geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

print("PREDICTED BY INTERACTION")
## [1] "PREDICTED BY INTERACTION"
print("")
## [1] ""
f <- "MAKER_DESIGN ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
anova(mm4)
## Type III Analysis of Variance Table with Satterthwaite's method
##                         Sum Sq Mean Sq NumDF DenDF F value
## STIMULUS_CATEGORY        88006 29335.2     3   936 54.9818
## BLOCK                    15294  3058.9     5   312  5.7332
## STIMULUS_CATEGORY:BLOCK 130941  8729.4    15   936 16.3612
##                                        Pr(>F)    
## STIMULUS_CATEGORY       < 0.00000000000000022 ***
## BLOCK                              0.00004446 ***
## STIMULUS_CATEGORY:BLOCK < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm4)
means <- estimate_means(mm4, at=c("BLOCK","STIMULUS_CATEGORY"))
contrasts <- estimate_contrasts(mm4, c("BLOCK","STIMULUS_CATEGORY"),method="pairwise")
plot(contrasts, means) + facet_wrap("STIMULUS_CATEGORY")+
    # geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) + 
  theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)", 
                         subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))

## TEST MODEL FIT 
# test_performance(mm2,mm3)    
# test_performance(mm2,mm4)    
# test_performance(mm3,mm4)    
anova(mm2,mm3)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm2: r_MAKER_DESIGN ~ STIMULUS_CATEGORY + (1 | PID)
## mm3: r_MAKER_DESIGN ~ BLOCK + (1 | PID)
##     npar   AIC   BIC  logLik deviance Chisq Df Pr(>Chisq)
## mm2    6 12002 12032 -5994.8    11990                    
## mm3    8 12101 12142 -6042.6    12085     0  2          1
print("the model with CATEGORY is not a significantly better fit than the model with BLOCK")
## [1] "the model with CATEGORY is not a significantly better fit than the model with BLOCK"
test_likelihoodratio(mm2, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name |           Model | df | df_diff |   Chi2 |      p
## -------------------------------------------------------
## mm2  | lmerModLmerTest |  6 |         |        |       
## mm4  | lmerModLmerTest | 26 |      20 | 250.10 | < .001
print("interaction better fit than category")
## [1] "interaction better fit than category"
test_likelihoodratio(mm3, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
## 
## Name |           Model | df | df_diff |   Chi2 |      p
## -------------------------------------------------------
## mm3  | lmerModLmerTest |  8 |         |        |       
## mm4  | lmerModLmerTest | 26 |      18 | 345.87 | < .001
print("interaction better fit than block")
## [1] "interaction better fit than block"
compare_models(mm2,mm3,mm4)
## Parameter                          |                  mm2 |                   mm3 |                     mm4
## -----------------------------------------------------------------------------------------------------------
## (Intercept)                        | 47.57 (44.58, 50.56) | 54.07 ( 50.10, 58.04) |  57.91 ( 51.29,  64.52)
## STIMULUS CATEGORY (B)              | -0.26 (-4.26,  3.75) |                       |  -6.20 (-14.84,   2.44)
## STIMULUS CATEGORY (C)              |  5.50 ( 1.49,  9.51) |                       |  -9.40 (-18.04,  -0.76)
## STIMULUS CATEGORY (D)              | 20.12 (16.12, 24.13) |                       |   0.25 ( -8.39,   8.90)
## BLOCK (B2)                         |                      |  4.42 ( -1.27, 10.11) |  -4.97 (-14.46,   4.52)
## BLOCK (B3)                         |                      | -0.43 ( -6.12,  5.26) | -18.37 (-27.86,  -8.88)
## BLOCK (B4)                         |                      |  3.21 ( -2.43,  8.84) |  -8.09 (-17.49,   1.30)
## BLOCK (B5)                         |                      | -9.50 (-15.17, -3.84) | -19.46 (-28.90, -10.01)
## BLOCK (B6)                         |                      |  1.36 ( -4.34,  7.05) | -11.68 (-21.17,  -2.19)
## STIMULUS CATEGORY (B) × BLOCK (B3) |                      |                       |  25.85 ( 13.46,  38.25)
## STIMULUS CATEGORY (B) × BLOCK (B2) |                      |                       | -15.76 (-28.16,  -3.37)
## STIMULUS CATEGORY (C) × BLOCK (B2) |                      |                       |  33.84 ( 21.45,  46.24)
## STIMULUS CATEGORY (D) × BLOCK (B2) |                      |                       |  19.46 (  7.06,  31.85)
## STIMULUS CATEGORY (C) × BLOCK (B4) |                      |                       |  16.21 (  3.94,  28.49)
## STIMULUS CATEGORY (C) × BLOCK (B3) |                      |                       |   6.25 ( -6.15,  18.64)
## STIMULUS CATEGORY (D) × BLOCK (B3) |                      |                       |  39.67 ( 27.27,  52.06)
## STIMULUS CATEGORY (B) × BLOCK (B4) |                      |                       |  -0.76 (-13.04,  11.51)
## STIMULUS CATEGORY (D) × BLOCK (B5) |                      |                       |  19.48 (  7.15,  31.82)
## STIMULUS CATEGORY (D) × BLOCK (B4) |                      |                       |  29.75 ( 17.47,  42.02)
## STIMULUS CATEGORY (B) × BLOCK (B5) |                      |                       |  18.43 (  6.09,  30.76)
## STIMULUS CATEGORY (C) × BLOCK (B5) |                      |                       |   1.91 (-10.43,  14.25)
## STIMULUS CATEGORY (B) × BLOCK (B6) |                      |                       |   8.26 ( -4.14,  20.65)
## STIMULUS CATEGORY (C) × BLOCK (B6) |                      |                       |  32.25 ( 19.85,  44.64)
## STIMULUS CATEGORY (D) × BLOCK (B6) |                      |                       |  11.63 ( -0.77,  24.03)
## -----------------------------------------------------------------------------------------------------------
## Observations                       |                 1272 |                  1272 |                    1272
compare_performance(mr1, mr2, mm1,mm2,mm3,mm4, rank=TRUE)
## # Comparison of Model Performance Indices
## 
## Name |           Model | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## mm4  | lmerModLmerTest |      0.347 |      0.235 | 0.147 | 21.684 | 23.099 |       0.500 |        0.500 |    7.26e-15 |            79.16%
## mm1  | lmerModLmerTest |      0.347 |      0.235 | 0.147 | 21.684 | 23.099 |       0.500 |        0.500 |    7.26e-15 |            79.16%
## mr2  | lmerModLmerTest |      0.347 |      0.000 | 0.347 | 21.698 | 23.100 |    1.75e-11 |     3.03e-11 |       1.000 |            62.44%
## mm2  | lmerModLmerTest |      0.179 |      0.085 | 0.103 | 24.672 | 25.745 |    1.20e-46 |     2.03e-46 |    3.97e-38 |            21.94%
## mm3  | lmerModLmerTest |      0.071 |      0.025 | 0.047 | 26.801 | 27.426 |    2.58e-68 |     4.28e-68 |    4.97e-62 |             1.51%
## mr1  | lmerModLmerTest |      0.067 |      0.000 | 0.067 | 26.644 | 27.426 |    3.33e-72 |     5.79e-72 |    2.49e-60 |             1.21%
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"


## PLOT BEST FIT MODEL PREDICTIONS
(p_design <- cat_plot(mm4, pred = BLOCK, modx = STIMULUS_CATEGORY,
         geom = "line", interval.geom= "linerange", 
         interval=TRUE, int.type = "confidence", int.width = 0.95, robust = TRUE,
         plot.points = FALSE) + 
    facet_wrap(~STIMULUS_CATEGORY) + 
    labs(title = "LMER Predictions | MAKER_DESIGN by BLOCK X CATEGORY", 
         caption = f, 
         y="MAKER_DESIGN \n 0(layerpson) --> 100 (professional)") + easy_remove_legend()
)

# if(GRAPH_SAVE){
#   ggsave(plot = p_design, path="figs/level_category/models", filename =paste0("lmer_maker_DESIGN_by_stimulus_category","_ixn.png"), units = c("in"))
# }


## PLOT MODEL PARAMETERS
plot_model(mm4, type = "est",
        # show.intercept = TRUE,
        show.values = TRUE,
        value.offset = .25,
        show.p = TRUE
) + theme_minimal() + labs(caption=f)

INTERPRETATION Here we see that a linear mixed effects model, predicting MAKER_DESIGN by the combination of STIMULUS_CATEGORY and BLOCK indicates that ratings of maker design competencies do NOT vary consistently as a function of CATEGORY (i.e. the degree of ‘embellishment’). Although the degree of embellishment within a block (A,B,C,D) is the same, the ratings of maker design competency vary. This pattern is particularly salient in category C. These data suggest that social inferences about a maker’s design competency are not made solely based on the amount of embellishment, but rather, in response to the particular features of the visualization. A highly embellished chart might be rated with relatively high design competency (e.g. B2-C) or lower data competency (eg. B5-C).